PDA

View Full Version : Remove pictures/shapes of PowerPoint with VBA



Djani
03-22-2016, 03:00 AM
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
03-22-2016, 03:27 AM
Why should you want to remove all slides in a Powerpoint presentation ???

Djani
03-22-2016, 03:38 AM
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
03-22-2016, 03:58 AM
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