Solved

excel vba delete all shapes on active slide

Posted on 2011-09-11
4
1,148 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 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 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

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Preface: When I started this series, I used the term CommandBars because that is the Office Object class that it discusses. Unfortunately, when Microsoft introduced Office 2007, they replaced the standard Commandbar menus with "The Ribbon" and rem…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

740 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