VBA to Delete all Images in a PowerPoint

[BVAmateur_12]

Hi all,

I'm currently looking for a simple VBA to delete all the images in a PowerPoint. I have tried solutions in a number of threads with no luck. At the moment I'm using a script which deletes all the pictures on a specific slide which works well but a simple 'delete all' button would be useful. The code I'm using at the moment is detailed below.


Sub delete_pics()


Dim osld As Slide
Dim opic As Shape
Dim lngCount As Long
On Error GoTo err
err.Clear
For Each osld In ActiveWindow.Selection.SlideRange
For lngCount = osld.Shapes.Count To 1 Step -1
Set opic = osld.Shapes(lngCount)
Select Case opic.Type
Case Is = msoPlaceholder
If opic.PlaceholderFormat.ContainedType = msoPicture Then opic.Delete
Case Is = msoPicture
opic.Delete
End Select
Next lngCount
Next osld
Exit Sub
err:
MsgBox "Did you select slides?"
End Sub



I'm new to Excel VBA therefore any simple code with simple instructions would be much appreciated!

Thanks

[Paul_Hossler]

1. I added CODE tags to you post - use the [#] icon to add then

2. Interesting. Deleting 'bottoms up' is still required, and I added the ability to handle a single level of grouped items

3. I learned that if you delete all but one shape in a Group, then it becomes a 'regular' shape



Option Explicit


Sub delete_pics()
Dim osld As Slide
Dim oshp As Shape, oshp2 As Shape
Dim iShp As Long, ishp2 As Long

For Each osld In ActivePresentation.Slides
For iShp = osld.Shapes.Count To 1 Step -1

Set oshp = osld.Shapes(iShp)

Select Case osld.Shapes(iShp).Type

Case msoPlaceholder
If oshp.PlaceholderFormat.ContainedType = msoPicture Then oshp.Delete

Case msoPicture
oshp.Delete

Case msoGroup
For ishp2 = oshp.GroupItems.Count To 2 Step -1

Set oshp2 = oshp.GroupItems(ishp2)

Select Case oshp2.Type
Case msoPlaceholder
If oshp2.PlaceholderFormat.ContainedType = msoPicture Then oshp2.Delete
Case msoPicture
oshp2.Delete
End Select
Next ishp2
End Select
Next iShp

'second pass since if a Group has all but 1 picture deleted, it's not a group any more
For iShp = osld.Shapes.Count To 1 Step -1

Set oshp = osld.Shapes(iShp)

If oshp.Type = msoPicture Then oshp.Delete
Next iShp

Next


End Sub

[BVAmateur_12]

Hi Paul,

That is fantastic, works a treat. Thank you for your help :beerchug:

All the best