Solved

excel vba delete all shapes on active slide

Posted on 2011-09-11
4
1,120 Views
Last Modified: 2012-05-12
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
0
Comment
Question by:montrof
  • 2
  • 2
4 Comments
 
LVL 41

Accepted Solution

by:
dlmille earned 500 total points
ID: 36520569
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
 
LVL 1

Author Closing Comment

by:montrof
ID: 36522280
Thank you how do you change it to Early binding? I have the Powerpoint library installed.
0
 
LVL 41

Expert Comment

by:dlmille
ID: 36523843
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
 
LVL 1

Author Comment

by:montrof
ID: 36523974
Thank you so much
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction In all recent versions of PowerPoint it is possible to trigger animations. This means the animation takes place when a certain shape is clicked. This allows you to run animation “on demand” and outwith the normal sequence of mouse cl…
PowerPoint is the go-to presentation software for millions of users around the world. Many presentations use basic text features but you can really make special text jump out of your slide by applying this bubble text design process. This article ha…
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…

930 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now