简体   繁体   中英

DELETE OLD CHART in powerpoint presentation from VBA EXCEL MACRO

I wolud like to delete several different old Charts in some PowerPoint presentation, all the items that I want to delete are called "Object n".

I have already tried some differents code but no one of those works. the Problem is that I cannot get the Name of the Shapes.

Set ppApp = GetObject(, "Powerpoint.Application")

Set ppPres = ppApp.ActivePresentation

Set PPSLIDE = ppPres.Slides

For Each PPShape In ppApp.ActiveWindow.Selection.SlideRange.Shapes

    If Left$(PPShape.Name, 6) = "Object" Then

        PPShape.Delete
    End If

Next PPShape

I suppose you need something like this:

Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim ppShape As PowerPoint.Shape

Set ppApp = GetObject(, "Powerpoint.Application")
Set ppPres = ppApp.ActivePresentation

For Each ppSlide In ppPres.Slides
    For Each ppShape In ppSlide.Shapes
        If Left$(ppShape.Name, 6) = "Object" Then

            ppShape.Delete

        End If
    Next ppShape
Next ppSlide

EDIT

I made this presentation:

原始演示

It contains three slides with these shapes:

  • Slide 1 Oval 3
  • Slide 1 Rectangle 4
  • Slide 1 5-Point Star 5
  • Slide 2 Object 1
  • Slide 2 Object 2
  • Slide 2 Table 3
  • Slide 2 Isosceles Triangle 4
  • Slide 3 Object 1
  • Slide 3 Object 2
  • Slide 3 Object 3
  • Slide 3 Right Arrow 4

I had to use VBA to rename the charts. Some pasted as Microsoft Office Graphic Objects were named "Chart x", others pasted as pictures were named "Picture y".

I used this exact procedure in an Excel workbook (unchanged from what I posted yesterday):

Sub KillPowerPointCharts()
  Dim ppApp As PowerPoint.Application
  Dim ppPres As PowerPoint.Presentation
  Dim ppSlide As PowerPoint.Slide
  Dim ppShape As PowerPoint.Shape

  Set ppApp = GetObject(, "Powerpoint.Application")
  Set ppPres = ppApp.ActivePresentation

  For Each ppSlide In ppPres.Slides
    For Each ppShape In ppSlide.Shapes
      If Left$(ppShape.Name, 6) = "Object" Then

        ppShape.Delete

      End If
    Next ppShape
  Next ppSlide
End Sub

The Excel workbook has the following reference added (VB editor > Tools menu > References): Microsoft PowerPoint 16.0 Object Library

The version number (16.0) does not matter. It should work in Office 16 (2016), 15 (2013), 14 (2010), 12 (2007), and even earlier. Just find PowerPoint in the list of references, and check it.

Alternatively, use "Late Binding", and change all the declared types from PowerPoint.Something to Object .

I ran the procedure above, and no errors were encountered. Some (not all) of the charts were removed. I ran the code a second time, and the remaining ones were deleted. This could be a timing issue between the two applications. Knowing it might be an issue, I made a small modification to the procedure to incorporate a loop:

Sub KillPowerPointCharts()
  Dim ppApp As PowerPoint.Application
  Dim ppPres As PowerPoint.Presentation
  Dim ppSlide As PowerPoint.Slide
  Dim ppShape As PowerPoint.Shape
  Dim i As Long

  Set ppApp = GetObject(, "Powerpoint.Application")
  Set ppPres = ppApp.ActivePresentation

  For i = 1 To 2
    For Each ppSlide In ppPres.Slides
      For Each ppShape In ppSlide.Shapes
        If Left$(ppShape.Name, 6) = "Object" Then

          ppShape.Delete

        End If
      Next ppShape
    Next ppSlide
  Next
End Sub

This procedure took out all of the charts.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM