如何彻底解决用vba批量删除ppt幻灯片中的图形等对象？

在ppt vba中如果要循环批量删除幻灯片中的图形等对象，会遇到很多困难。

比如当执行如下For Each … In 的vba代码删除ppt中第一张幻灯片中的所有图片后，会发现并没有将图片全部删除。

Sub QQ1722187970()
    Dim oPPT As PowerPoint.Presentation
    Dim oSlide  As Slide
    Set oPPT = PowerPoint.ActivePresentation
    Dim oSP As Shape
    With oPPT
        Set oSlide = .Slides(1)
        With oSlide
           For Each oSP In .Shapes
                oSP.Delete
           Next
        End With
    End With
End Sub

当修改为执行如下的For i = 1 To .Shapes.Count 的vba代码删除ppt中第一张幻灯片中的所有图片时

Sub QQ1722187970()
    Dim oPPT As PowerPoint.Presentation
    Dim oSlide  As Slide
    Set oPPT = PowerPoint.ActivePresentation
    Dim oSP As Shape
    With oPPT
        Set oSlide = .Slides(1)
        With oSlide
           For i = 1 To .Shapes.Count
                Set oSP = .Shapes(i)
                oSP.Delete
          Next i
        End With
    End With
End Sub

会弹出数字已经超出边界的提示错误如下图所示：

以上两种批量删除对象的方法在excel vba和word vba中都是最常用的，而且也是最安全的删除方法，但是到了ppt vba中却都不行了，经过仔细的分析，原来ppt vba中每删除一个对象，会自动调整所有对象的索引号，导致有些索引号空缺，从而出现删不尽或者索引号超出边界的现象发生。

为了解决这个问题，需要每次将要删除的对象的名称存入数组，然后用ShapeRange对象删除，代码如下：

Sub QQ1722187970()
    Dim oPPT As PowerPoint.Presentation
    Dim oSlide  As Slide
    Set oPPT = PowerPoint.ActivePresentation
    Dim oSP As Shape
    Dim oSPRange As ShapeRange
    Dim arr()
    With oPPT
        Set oSlide = .Slides(1)
        With oSlide
          For Each oSP In .Shapes
            ReDim Preserve arr(k)
            arr(k) = oSP.Name
            k = k + 1
          Next
        Set oSPRange = .Shapes.Range(arr)
        oSPRange.Delete
        End With
    End With
End Sub