Remove pictures/shapes of PowerPoint with VBA

[Djani]

Dear all,

I have a VBA script that should remove all pictures/shapes in the active PowerPoint presentation, but it's not working. I'm not an expert in VBA, so could any of you help me out with this?

Sub DeleteAllPictures()
     
    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)
                If .Type = msoPicture Then
                    .delete
                End If
            End With
        Next
    Next
     
End Sub

It gives the error "ActiveX component can't create object" at "For Each sldTemp In ActivePresentation.Slides". It should be very simple, just deleting all shapes.
I do understand that I have to make a reverse loop in order to delete all pictures!

Yours sincerely,

Djani

[snb]

Why should you want to remove all slides in a Powerpoint presentation ???

[Djani]

Not all slides, all shapes on the slides. I have actually found something which this does, but can I also tell the macro to delete shapes on specific slides? E.g. remove all shapes on slide 2,4,6,7 etc.

This is the properly working code which needs some refinement:

Sub DeletePictures()
    Dim objApp, objSlide, ObjShp
    On Error Resume Next
    Set objApp = CreateObject("PowerPoint.Application")
    On Error GoTo 0
    For Each objSlide In objApp.ActivePresentation.Slides
        For Each ObjShp In objSlide.Shapes
            If ObjShp.Type = msoPicture Then ObjShp.Delete
        Next
    Next
End Sub

Yours sincerely,

Djani

[Djani]

I figured it would be something like this, but it gives "ActiveX can't create component object" while I have it linked to the PowerPoint Objects.

Sub DeleteAllPictures()
     
    Dim sldTemp As Slide
    Dim lngTemp As Long
    Dim lngCount As Long
     
    Dim SlideList() As Variant
    Dim Slide As Variant
    SlideList = Array(3, 4, 8, 9, 10, 11, 12)
     
    For Each Slide In SlideList
         
        Set sldTemp = ActivePresentation.Slides(Slide)
        For lngCount = sldTemp.Shapes.Count To 1 Step -1
            With sldTemp.Shapes(lngCount)
                If .Type = msoPicture Then
                    .Delete
                End If
            End With
        Next
    Next
     
End Sub

It gives the error at "Set sldTemp = ActivePresentation.Slides(Slide)"

Yours sincerely,

Djani