?
Solved

excel vba delete all shapes on active slide

Posted on 2011-09-11
4
Medium Priority
?
1,195 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
  • 2
4 Comments
 
LVL 42

Accepted Solution

by:
dlmille earned 2000 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 42

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

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

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

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…
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
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…
This Micro Tutorial will demonstrate the scrolling table in Microsoft Excel using the INDEX function.

752 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