从VBA EXCEL MACRO中删除PowerPoint演示文稿中的旧图表

我想在一些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 

编辑

我做了这个介绍：

它包含三个这些形状的幻灯片：

• 幻灯片1椭圆形3
• 幻灯片1矩形4
• 幻灯片5五angular星5
• 幻灯片2对象1
• 幻灯片2对象2
• 幻灯片2表3
• 幻灯片2等腰三angular形4
• 幻灯片3对象1
• 幻灯片3对象2
• 幻灯片3对象3
• 幻灯片3右箭头4

我不得不使用VBA来重命名图表。 一些粘贴为Microsoft Officegraphics对象命名为“图表x”，其他粘贴为图片命名为“图片y”。

我在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编辑器>工具菜单>参考）：Microsoft PowerPoint 16.0对象库

版本号（16.0）无关紧要。 它应该在Office 16（2016），15（2013），14（2010），12（2007）甚至更早的时间工作。 只需在参考文献列表中findPowerPoint，并检查它。

或者，使用“延迟绑定”，并将所有声明的types从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 

这个程序拿出了所有的图表。