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

Question

我正在更新我的 MS PowerPoint，方法是使用 VBA 在不同的幻灯片上粘贴图像。

其余代码运行良好。我无法做的是删除所有幻灯片上的现有图像并粘贴新图像。目前它将新图像粘贴在旧图像之上，但旧图像仍然存在。我正在使用以下代码：

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

Edit1: 正如史蒂夫指出的那样，第一个 posted 解决方案不可靠；也正如 Doug 在 POST 中确认的那样。

要使用循环删除所有图片，请按照 Steve 在他的 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

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

Answer 2

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

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

Replace existing image in MS PowerPoint with a new image using VBA

excel

powerpoint

vba