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

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

编辑1：正如史蒂夫指出的那样，第一个发布的解决方案是不可靠的;道格在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

希望这会有所帮助，但更简单的解决方案就是史蒂夫。：）

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

2 个答案: