Thread: [Solved] recording macro in ppt 2007
View Single Post
 
Old 12-14-2011, 12:59 AM
JohnWilson JohnWilson is offline Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,913
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

See if this gets you closer:

Code:
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
__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote