问题描述：

　　在ppt vba中如果要循环批量删除Shape对象，会遇到很多困难。比如当执行如下For Each … In 的vba代码删除ppt中第一页的所有图片后，会发现并没有将图片全部删除：

Sub DeleteBrandLogo()
    Dim pre As PowerPoint.Presentation, shp As PowerPoint.Shape, Sli As PowerPoint.Slide
    For Each sld In pre.Slides
        For Each shp In sld.Shapes
            If shp.Name Like "LOGO_*" Then
                shp.DeleteEnd If
        Next
    Next
End Sub

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

Sub DeleteBrandLogo()
    Dim pre As PowerPoint.Presentation, shp As PowerPoint.Shape, Sli As PowerPoint.Slide,i&
    For Each sld In pre.Slides
        For i = 1 to sld.Shapes.Count
            If sld.Shapes(i).Name Like "LOGO_*" Then
                sld.Shapes(i).Delete
            End If
        Next
    Next
End Sub

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

解决办法：

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

2. 解决办法：需要每次将要删除的对象的名称存入数组，然后用ShapeRange对象删除：

   Sub DeleteBrandLogo(pre As PowerPoint.Presentation)
       Dim shp As PowerPoint.Shape, Sli As PowerPoint.Slide, arr(), k&, lb&
       For Each sld In pre.Slides
           k = 0
           Erase arr
           For Each shp In sld.Shapes
               If shp.Name Like "LOGO_*" Then
                   ReDim Preserve arr(k)
                   arr(k) = shp.Name
                   k = k + 1
               End If
           Next
           On Error Resume Next
           lb = UBound(arr)
           If Err.Number <> 9 Then
               sld.Shapes.Range(arr).Delete
               Debug.Print "Delete P" & sld.SlideIndex & ":" & Join(arr, ",")
           End If
           On Error GoTo 0
       Next
       Debug.Print "delete ok!"
   End Sub

   执行完代码后，发现已经全部删除好了！

标签：shp,VBA,删除,arr,Next,Shape,PPT,sld,PowerPoint
来源： https://www.cnblogs.com/zhengxianfa/p/16505335.html