VBA Picture Positioning

[cole10]

I have a powerpoint slide that has 5 images on it. I have written a code that crops all images, resizes them and then aligns them centrally, but i want each image to be in the vertical position 100 points below the one above. Currently my code looks like this:

Sub CropResize()
Dim sldTemp As Slide
Dim lngTemp As Long
Dim lngCount As Long
For Each sldTemp In ActivePresentation.Slides
For lngCount = sldTemp.Shapes.Count To 1 Step -1


With sldTemp.Shapes(lngCount)
.PictureFormat.CropLeft = 100
.PictureFormat.CropTop = 55
.PictureFormat.CropRight = 70
.PictureFormat.CropBottom = 100
.LockAspectRatio = msoTrue
.Height = 100
.IncrementLeft 275
.IncrementTop 100

End With
Next
Next
Set screens = ActivePresentation.Slides(1)
screens.Shapes.Range.Align msoAlignCenters, msoTrue
End Sub


Which positions the top image perfectly, but i then want the one below to be at vertical position 100 + 100 and the third image to be 100 + 200 (ie 100 + image# x 100). I thought about using a 'for' function so for image 1 to 5 position is 100+image*100 type function but can't get it to work, it always comes up as an error. all help welcome please! (Sorry if i havent been clear!)

[JohnWilson]

Does this do it?

Sub CropResize()
Dim osld As Slide
Dim oshp As Shape
Dim x As Integer
On Error Resume Next
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
End With
x = x + 1
End If
Next oshp
osld.Shapes.Range.Align msoAlignCenters, msoTrue
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

[cole10]

Thanks John that is exactly what I was after, its fantastic! Wasn't aware of the .Top function to position, but its ideal. Is there anyway I can position them (aligned) off centre? i.e have them all in a neat column but to the left of the slide? Thank you again!

[JohnWilson]

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

[cole10]

yes thats perfect, huge thank you!