Try this
Sub CropResize()
Dim osld As Slide
Dim oshp As Shape
Dim x As Integer
For Each osld In ActivePresentation.Slides
If osld.SlideIndex > 1 Then Exit Sub
For Each oshp In osld.Shapes
If CheckIsPic(oshp) = True Then
With oshp
.PictureFormat.CropLeft = 100
.PictureFormat.CropTop = 55
.PictureFormat.CropRight = 70
.PictureFormat.CropBottom = 100
.LockAspectRatio = msoTrue
.Height = 100
.Top = x * 100
.Select Replace:=False 'Select picture but keep any others selected
End With
x = x + 1
End If
Next oshp
'this is a better method as it will exclude any non pictures
With ActiveWindow.Selection.ShapeRange
.Align (msoAlignCenters), msoTrue
.Left = 10
End With
Next osld
End Sub
Function CheckIsPic(oshp As Shape) As Boolean
If oshp.Type = msoPicture Then CheckIsPic = True
If oshp.Type = msoPlaceholder Then
If oshp.PlaceholderFormat.ContainedType = msoPicture Then CheckIsPic = True
End If
End Function
|