PDA

View Full Version : [SOLVED:] Removing Pictures of a Certain Size



hunter21188
11-19-2015, 10:29 AM
Hi, I am new to VBA and I am trying to create a command button that when clicked removes all images within the active slide that match a specified size (in this case, all images that are "Width:=187, Height:=139"). Is this even possible?

I am completely stumped and am not really sure where to begin. Any help would be greatly appreciated - thanks!

John Wilson
11-19-2015, 10:57 AM
Probably forget the command button. In PPT they only work in slide show mode. Just use View > Macro > run

How are you measuring the size (ie what units)

If POINTS something like this:


Sub zapPix() Dim osld As Slide
Dim L As Long
Set osld = ActiveWindow.Selection.SlideRange(1)
For L = osld.Shapes.Count To 1 Step -1
' image on slide
If osld.Shapes(L).Type = msoPicture Then
If osld.Shapes(L).Width = 187 And osld.Shapes(L).Height = 139 Then osld.Shapes(L).Delete
End If
'image in Placeholder
If osld.Shapes(L).Type = msoPlaceholder Then
If osld.Shapes(L).PlaceholderFormat.ContainedType = msoPicture Then
If osld.Shapes(L).Width = 187 And osld.Shapes(L).Height = 139 Then osld.Shapes(L).Delete
End If
End If
Next L
End Sub

hunter21188
11-19-2015, 11:27 AM
So close! That deletes one image at a time, and then I get this error: Shapes (unknown member): Integer out of range. 14 is not in the valid range of 1 to 13.

Any ideas on why that is popping up. You included the Count To 1 Step -1, and I thought that would have made it work. Thanks so much for your help!

--EDIT--

I just removed the placeholder section of the code since they are all pictures, and that fixed it! Thanks!!

John Wilson
11-19-2015, 02:38 PM
That would be a flaw in my code. If the shapes were removed the check for placeholders would look for a non existant shape.
You could avoid this like this:


Sub zapPix()
Dim osld As Slide
On Error Resume Next
Dim L As Long
Set osld = ActiveWindow.Selection.SlideRange(1)
For L = osld.Shapes.Count To 1 Step -1
' image on slide
If osld.Shapes(L).Type = msoPicture Then
If osld.Shapes(L).Width = 187 And osld.Shapes(L).Height = 139 Then osld.Shapes(L).Delete
End If
Next L
For L = osld.Shapes.Count To 1 Step -1
'image in Placeholder
If osld.Shapes(L).Type = msoPlaceholder Then
If osld.Shapes(L).PlaceholderFormat.ContainedType = msoPicture Then
If osld.Shapes(L).Width = 187 And osld.Shapes(L).Height = 139 Then osld.Shapes(L).Delete
End If
End If
Next L
End Sub

hunter21188
11-20-2015, 03:57 AM
I see. That did the trick! Thanks a lot, John!!