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

Question

我正在通过使用 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 的新手，我不知道在哪里以及如何在上面的代码中添加删除命令。任何形式的帮助将不胜感激。

Answer 1

这（感谢 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

为什么？假设幻灯片上有三个形状。我们遍历shapes集合，发现第一个shape是图片，删除。现在形状集合中有两个形状，但 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

Answer 2

Edit1： 正如史蒂夫指出的那样，第一个发布的解决方案是不可靠的； Doug 在POST 中也证实了这一点。

要使用循环删除所有图片，请采用史蒂夫在他的帖子中解释的方法。
现在，如果你只想删除所有图片，你可以试试这个：

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

希望这会有所帮助，但史蒂夫的解决方案更简单。 :)