使用VBA将MS PowerPoint中的现有图像replace为新图像

我通过使用VBA在不同的幻灯片上粘贴图像来更新我的MS PowerPoint。

其余的代码工作正常。 我无法做的是删除所有幻灯片上的现有图像,并粘贴新的图像。 目前它将新图像粘贴在旧图像上,但旧图像保留。 我使用下面的代码:

Dim pptApp As PowerPoint.Application Set pptApp = CreateObject("PowerPoint.Application") pptApp.Visible = msoTrue xlApp.Worksheets(2).Range("M2:S12").Copy Set shp1 = ActivePresentation.Slides(17).Shapes.PasteSpecial(ppPasteEnhancedMetafile)(1) With shp1 .Left = 370 .Top = 100 .Height = 360 .Width = 340 End With 

作为VBA的新手,我不知道在哪里以及如何添加删除命令在上面的代码。 任何forms的帮助,将不胜感激。

这个(谢谢L42)可以用于幻灯片上的单个msoPicture形状,但是如果有多个形状,它可能会错过一些:

 Dim s As Shape For Each s In ActivePresentation.Slides(17).Shapes If s.Type = 13 Then s.Delete '13 is msoPicture Next 

为什么? 假设你在幻灯片上有三个形状。 我们遍历形状集合,发现第一个形状是一个图片,并删除它。 现在形状集合中有两个形状,但VBA的计数器不考虑集合计数的变化。 它看着集合中的第二个形状,但是现在这就是幻灯片中的第三个形状,所以代码将完全没有形状#2。

使用这样的东西更可靠:

 Dim x as Long For x = ActivePresentation.Slides(17).Shapes.Count to 1 Step -1 If ActivePresentation.Slides(17).Shapes(x).Type = msoPicture Then ActivePresentation.Slides(17).Shapes(x).Delete End If Next 

编辑1:正如史蒂夫指出的,第一个发布的解决scheme是不可靠的, 也正如Doug在本文中所证实的那样。

要使用循环删除所有图片,请按照他的文章中的解释采取Steve的方法。
现在,如果你只是想删除所有的图片,你可以试试这个:

 ActivePresentation.Slides(17).Shapes.Range.Delete 

但是这删除所有的形状,不仅图片,而且文本框,线条,形状等。
要只删除图片,下面是使用循环的另一种方法。

 Dim s As Shape, pictodel As Variant For Each s In ActivePresentation.Slides(17).Shapes If s.Type = 13 Then If IsArray(pictodel) Then ReDim Preserve pictodel(UBound(pictodel) + 1) pictodel(UBound(pictodel)) = s.Name Else pictodel = Array(s.Name) End If End If Next ActivePresentation.Slides(17).Shapes.Range(pictodel).Delete 

希望这有帮助,但更简单的解决scheme将是史蒂夫的。 🙂