excel vba delete all shapes on active slide

Hi all i need some help with deleting all the shapes on a current slide in powerpoint and I will be doing this through excel vba.  I appreciate any help you could provide.

Montrof
LVL 1
montrofAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
dlmilleConnect With a Mentor Commented:
Kind of an interesting one.  While you can select all shapes, I couldn't find a method to just .Delete them!  App finds an existing instance of Powerpoint, and current slide, then enumerates all shapes into an array.  App then traverses array, backwards, deleting each shape, one at a time.

Here's the code (note, I used late binding, so all the variables are Object type.  If you have PowerPoint Reference Library added to your VBA, you can change and use the early binding settings, thus allowing intellisense, etc.)

   
Sub delPPTShapesActiveSlide()
'You can use early binding types, rather than object, on the below variables, by adding the Microsoft Powerpoint X.X Reference Library

Dim oPPTApp As Object 'early binding use: PowerPoint.Application
Dim oPPTFile As Object 'early binding use: PowerPoint.Presentation
Dim oPPTSlide As Object 'early binding use: PowerPoint.Slide
Dim oPPTShape As Object 'early binding use: PowerPoint.Shape
Dim oPPTShapeArray() As Object 'early binding use: PowerPoint.Shape
Dim i As Long

    On Error GoTo errHandler
    Set oPPTApp = GetObject(, "Powerpoint.Application") 'reference active powerpoint
     
    ' Reference active presentation
    Set oPPTFile = oPPTApp.ActivePresentation 'reference active presentation
    oPPTApp.ActiveWindow.ViewType = 1 'early binding use: ppViewSlide 'ensure in slide view mode, for modification
    Set oPPTSlide = oPPTApp.ActiveWindow.View.Slide 'gets the active slide
 
    'enumerate shapes into array
    For Each oPPTShape In oPPTSlide.Shapes
        ReDim Preserve oPPTShapeArray(i) As Object 'early binding use PowerPoint.Shape
        Set oPPTShapeArray(i) = oPPTShape
        i = i + 1
    Next oPPTShape
    
    'then delete them, backwards to forwards, as there would be problems, deleting them serially
    For i = UBound(oPPTShapeArray) To LBound(oPPTShapeArray) Step -1
        oPPTShapeArray(i).Delete
    Next i
              
    Set oPPTApp = Nothing
    Set oPPTFile = Nothing
    Set oPPTShape = Nothing
    Exit Sub
    
errHandler:
    MsgBox "Error # " & Err.Number & "-> " & Err.Description, vbCritical, "Aborting."
End Sub

Open in new window


See attached workbook

Enjoy!

Dave
clearPPTShapes-r1.xlsm
0
 
montrofAuthor Commented:
Thank you how do you change it to Early binding? I have the Powerpoint library installed.
0
 
dlmilleCommented:
Early Binding:

 
Sub delPPTShapesActiveSlide()
'You can use early binding types, rather than object, on the below variables, by adding the Microsoft Powerpoint X.X Reference Library

Dim oPPTApp As PowerPoint.Application
Dim oPPTFile As PowerPoint.Presentation
Dim oPPTSlide As PowerPoint.Slide
Dim oPPTShape As PowerPoint.Shape
Dim oPPTShapeArray() As Object PowerPoint.Shape
Dim i As Long

    On Error GoTo errHandler
    Set oPPTApp = GetObject(, "Powerpoint.Application") 'reference active powerpoint
     
    ' Reference active presentation
    Set oPPTFile = oPPTApp.ActivePresentation 'reference active presentation
    oPPTApp.ActiveWindow.ViewType = ppViewSlide 'ensure in slide view mode, for modification
    Set oPPTSlide = oPPTApp.ActiveWindow.View.Slide 'gets the active slide
 
    'enumerate shapes into array
    For Each oPPTShape In oPPTSlide.Shapes
        ReDim Preserve oPPTShapeArray(i) As PowerPoint.Shape
        Set oPPTShapeArray(i) = oPPTShape
        i = i + 1
    Next oPPTShape
    
    'then delete them, backwards to forwards, as there would be problems, deleting them serially
    For i = UBound(oPPTShapeArray) To LBound(oPPTShapeArray) Step -1
        oPPTShapeArray(i).Delete
    Next i
              
    Set oPPTApp = Nothing
    Set oPPTFile = Nothing
    Set oPPTShape = Nothing
    Exit Sub
    
errHandler:
    MsgBox "Error # " & Err.Number & "-> " & Err.Description, vbCritical, "Aborting."
End Sub

Open in new window


Dave
0
 
montrofAuthor Commented:
Thank you so much
0
All Courses

From novice to tech pro — start learning today.