Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 286
  • Last Modified:

Delete starting from a specific slide

I need to change this macro so that it will start deleting shapes on the 3rd slide skipping the first two slides. Any help would be great.
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

Open in new window

0
montrof
Asked:
montrof
  • 3
  • 2
1 Solution
 
cynxCommented:
modified code to delete from slide number 3, if found
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 objSlide As Slide
Dim i As Long


    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
    For Each objSlide In oPPTFile.Slides
        Debug.Print objSlide.SlideNumber
        If objSlide.SlideNumber = 3 Then
            Set oPPTSlide = objSlide
            Exit For
        End If
    Next objSlide
    
   If oPPTSlide Is Nothing Then
        MsgBox "slide 3 not found"
        Exit Sub
    End If
    '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
End Sub

Open in new window

0
 
cynxCommented:
and this code starts deleting everything from slide 3 onwards, if you wanted that way !
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 objSlide As Slide
Dim i As Long


    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
    For Each objSlide In oPPTFile.Slides
        Set oPPTSlide = Nothing
        
        If objSlide.SlideNumber > 2 Then
            Set oPPTSlide = objSlide
        End If

    
        If Not oPPTSlide Is Nothing Then
             '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
        End If
    Next objSlide
    '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
End Sub

Open in new window

0
 
montrofAuthor Commented:
Perfect thanks for the help

Montrof
0
 
montrofAuthor Commented:
One more question if you do not mind. Is there any way to only remove shapes that the name of the shape begins with "ExcelSlide_".

Thanks,
Scott
0
 
montrofAuthor Commented:
Sorry, I figured it out. Thanks
0

Featured Post

Independent Software Vendors: 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!

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now