View Single Post
 
Old 08-06-2012, 11:32 PM
JohnWilson JohnWilson is offline Windows 7 64bit Office 2010 32bit
Programmer
 
Join Date: Nov 2008
Location: UK
Posts: 1,914
JohnWilson has a spectacular aura aboutJohnWilson has a spectacular aura about
Default

Try this:

Select the picture to use as a "template" then run the code:

Code:
Sub resize_pics()
Dim oshp As Shape
Dim oPic As Shape
Dim picH As Single
Dim picW As Single
Dim osld As Slide
If ActiveWindow.Selection.Type = ppSelectionNone Then GoTo err
If ActiveWindow.Selection.ShapeRange.Count <> 1 Then GoTo err
Set oshp = ActiveWindow.Selection.ShapeRange(1)

For Each osld In ActivePresentation.Slides
For Each oPic In osld.Shapes

If oPic.Type = msoPicture Then
picW = oPic.Width
picH = oPic.Height
oPic.LockAspectRatio = True
oPic.Width = oshp.Width
oPic.Left = oPic.Left - (oshp.Width - picW) / 2
oPic.Top = oPic.Top - (oshp.Height - picH) / 2
End If

If oPic.Type = msoPlaceholder Then
If oPic.PlaceholderFormat.ContainedType = msoPicture Then
picW = oPic.Width
picH = oPic.Height
oPic.LockAspectRatio = True
oPic.Width = oshp.Width
oPic.Left = oPic.Left - (oshp.Width - picW) / 2
oPic.Top = oPic.Top - (oshp.Height - picH) / 2
End If
End If

Next oPic
Next osld
Exit Sub
err:
MsgBox "Please select ONE shape and retry!", vbCritical
End Sub
__________________
Microsoft PowerPoint MVP 2007-2023
Free Advanced PowerPoint Tips and Tutorials
Reply With Quote