在VBA EXCEL MACRO的powerpoint演示文稿中删除旧图表

Question

我想在一些PowerPoint演示文稿中删除几个不同的旧图表，我要删除的所有项目都称为“对象n”。

我已经尝试了一些不同的代码，但没有一个有用。问题是我无法获得形状的名称。

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

Answer 1

我想你需要这样的东西：

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

修改

我做了这个演讲：

它包含三张具有以下形状的幻灯片：

• Slide 1 Oval 3
• 幻灯片1矩形4
• Slide 1 5-Point Star 5
• Slide 2 Object 1
• Slide 2 Object 2
• Slide 2 Table 3
• Slide 2 Isosceles Triangle 4
• 幻灯片3对象1
• 幻灯片3对象2
• 幻灯片3对象3
• Slide 3右箭4

我不得不使用VBA来重命名图表。一些粘贴为Microsoft Office图形对象被命名为＆＃34;图表x＆＃34;其他粘贴为图片被命名为＆＃34;图片y＆＃34;。

我在Excel工作簿中使用了这个确切的过程（与我昨天发布的内容相同）：

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

Excel工作簿添加了以下参考（VB编辑器＆gt;工具菜单＆gt;参考）： Microsoft PowerPoint 16.0对象库

版本号（16.0）无关紧要。它应该适用于Office 16（2016），15（2013），14（2010），12（2007）甚至更早。只需在参考文献列表中找到PowerPoint，然后进行检查即可。

或者，使用＆＃34; Late Binding＆＃34;，并将所有声明的类型从PowerPoint.Something更改为Object。

我运行了上面的程序，没有遇到任何错误。删除了一些（不是全部）图表。我第二次运行代码，剩下的代码被删除了。这可能是两个应用程序之间的时间问题。知道这可能是一个问题，我对程序进行了一些小修改以合并循环：

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

此程序取出了所有图表。