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
Solved

excel vba delete all shapes on active slide

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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
combine fist two words in a cell 2 23
Stop display of alerts in Word via Excel 12 18
Getting rid of #VALUE! 7 22
excel conditional formating 4 15
Technology opened people to different means of presenting information, but PowerPoint remains to be above competition. Know why PPT still works today.
Excel can be a tricky bit of software to get your head around. Whilst you’ll be able to eventually get to grips with the basic understanding of how to get by, there are a few Excel tips that not everybody will even know about let alone know how to d…
This Micro Tutorial demonstrate the bugs in Microsoft Excel for Mac with Pivot Charts.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

856 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