VBA Command to delete all shapes in specific PPT slides

[Djani]

Hi all,

I got a perfectly working VBA macro, but it deletes all shapes on ALL slides in the active PowerPoint.



Sub DeleteAllGraphsInPPT()
'This macro will only work if there is an active PowerPoint
'It removes all shapes, pictures and tables in the active PowerPoint
Dim objApp, objSlide, ObjShp, objTable
On Error Resume Next
'Is the PowerPoint open?
Set objApp = CreateObject("PowerPoint.Application")
On Error GoTo 0
'If the presentation is open, check each slides for shapes, pictures and/or tables
'and deletes them if they exist
For Each objSlide In objApp.ActivePresentation.Slides
For Each ObjShp In objSlide.Shapes
If ObjShp.Type = msoPicture Then
ObjShp.Delete
ElseIf ObjShp.Type = msoTable Then
ObjShp.Delete
ElseIf ObjShp.Type = msoChart Then
ObjShp.Delete
End If
Next
Next
End Sub



Is it possible to modify it and only delete all shapes from slides 2 until 8?

Yours sincerely,

Djani

[snb]

Yes it is possible, and yes you can modify this code yourself (eitje !) if you try to analyse what each line does.

[Paul_Hossler]

Which slide number?


http://skp.mvps.org/ppt00030.htm


The SlideIndex property returns the actual position of the slide within the presentation. The SlideNumber property returns the PageNumber which will appear on that slide. This property value is dependent on "Number Slide from" option in the Page Setup.

[Djani]

Slide numbers 2, 3, 4, 5, 6, 7, 8 in the active PowerPoint, but give me some time to figure it out myself!

[Djani]

I might be thinking too hard right now as I still can't figure it out - macro not working. However, I had the following in mind:



Sub DeleteAllGraphsInPPT()
'This macro will only work if there is an active PowerPoint
'It removes all shapes, pictures and tables in the active PowerPoint
Dim objApp, objSlide, ObjShp, objTable
For i = 2 To 8
On Error Resume Next
'Is the PowerPoint open?
Set objApp = CreateObject("PowerPoint.Application")
On Error GoTo 0
'If the presentation is open, check each slides for shapes, pictures and/or tables
'and deletes them if they exist
For Each ActivePresentation.Slides(i) In ActivePresentation
For Each ObjShp In objSlide.Shapes
If ObjShp.Type = msoPicture Then
ObjShp.Delete
ElseIf ObjShp.Type = msoTable Then
ObjShp.Delete
ElseIf ObjShp.Type = msoChart Then
ObjShp.Delete
End If
Next
End Sub



Is the logic good?

@Paul_Hossler: I took a look at the site, but I am not sure how to integrate the variable SlideNumber/SlideIndex in the current macro.

[Paul_Hossler]

I took a look at the site, but I am not sure how to integrate the variable SlideNumber/SlideIndex in the current macro.

Just a cautionary note about the slide number displayed and the slide number in the presentation

Most likely you're OK

Not tested, but I reversed your inner and out loops




Option Explicit
Sub DeleteAllGraphsInPPT()
'This macro will only work if there is an active PowerPoint
'It removes all shapes, pictures and tables in the active PowerPoint
Dim objApp As Object, objSlide As Object, ObjShp As Object, objTable As Object
Dim i As Long

On Error Resume Next
'Is the PowerPoint open?
Set objApp = CreateObject("PowerPoint.Application")
On Error GoTo 0

If objApp Is Nothing Then Exit Sub

If objApp.activepresentation Is Nothing Then Exit Sub

For i = 2 To 8
Set objSlide = objApp.activepresentation.slides(i)
For Each ObjShp In objSlide.Shapes
Select Case ObjShp.Type
Case msoPicture, msoTable, msoChart
ObjShp.Delete
End Select
Next
Next i
End Sub

[weewee]

:bow: Worked instantly! Thanks.... You are a life saver!



Just a cautionary note about the slide number displayed and the slide number in the presentation

Most likely you're OK

Not tested, but I reversed your inner and out loops




Option Explicit
Sub DeleteAllGraphsInPPT()
'This macro will only work if there is an active PowerPoint
'It removes all shapes, pictures and tables in the active PowerPoint
Dim objApp As Object, objSlide As Object, ObjShp As Object, objTable As Object
Dim i As Long

On Error Resume Next
'Is the PowerPoint open?
Set objApp = CreateObject("PowerPoint.Application")
On Error GoTo 0

If objApp Is Nothing Then Exit Sub

If objApp.activepresentation Is Nothing Then Exit Sub

For i = 2 To 8
Set objSlide = objApp.activepresentation.slides(i)
For Each ObjShp In objSlide.Shapes
Select Case ObjShp.Type
Case msoPicture, msoTable, msoChart
ObjShp.Delete
End Select
Next
Next i
End Sub

[Paul_Hossler]

Glad it still worked for you, but be advised this was a 2-3 year old thread so if there's other questions, make sure to start a new one

Even thought this is 'sort of' a PP question posted in Excel, I moved it to the PP forum

[John Wilson]

And a few comments
CreateObject will create a NEW empty presentation if none is open.

You might want to try


Set objApp = GetObject(Class:="Powerpoint.Application")


If objApp.activepresentation Is Nothing Then Exit Sub Is not a valid test. It will throw an error if no ActivePresentation is there.

Always loop backwards when deleting shapes. As written the code will usually work but not always.

Most important the test for charts,pictures and tables will fail if they are in placeholders. You need to check the contained type of placeholders.