Sub FittopageCurrent()
'Fits the last added shape to the box on the master
'on current slide
Dim oshp As Shape
Dim osld As Slide
Dim otarget As Shape
Set otarget = ActivePresentation.SlideMaster.Shapes("Rectangle 8")
Set osld = ActiveWindow.View.Slide
Set oshp = osld.Shapes(osld.Shapes.Count)
oshp.Left = otarget.Left
oshp.Top = otarget.Top
oshp.LockAspectRatio = False
oshp.Height = otarget.Height
oshp.Width = otarget.Width
Set oshp = Nothing
Set osld = Nothing
End Sub

Sub FittopageAll()
'Fits the last added shape to the box on the master
'on all slides
Dim oshp As Shape
Dim osld As Slide
Dim otarget As Shape
Set otarget = ActivePresentation.SlideMaster.Shapes("Rectangle 8")
For Each osld In ActivePresentation.Slides
If osld.Shapes.Count > 0 Then
Set oshp = osld.Shapes(osld.Shapes.Count)
oshp.Left = otarget.Left
oshp.Top = otarget.Top
oshp.LockAspectRatio = False
oshp.Height = otarget.Height
oshp.Width = otarget.Width
End If
Next osld
Set oshp = Nothing
Set osld = Nothing
End Sub