Powerpoint VBA，For Each循环期间的形状删除会跳过下一项

Question

我正在浏览Powerpoint幻灯片1中的形状

当名称为“ HD”的形状被删除时，下一个形状将变为“ SD”，跳过“ 4K”。如果删除了“ 4K”，则下一个形状变为“ FullHD”

如何避免这种情况？

For Each pshape In ppres.Slides(1).Shapes
    Select Case pshape.Name
        Case "HD"
            Debug.Print vbTab & pshape.Name
            If LCase(Cells(2, titleHeader.ListColumns("Nature of Material*").Index)) <> "hd" And LCase(Cells(2, titleHeader.ListColumns("Nature of Material*").Index)) = "" Then
                pshape.Delete
            End If
        Case "4K"
            Debug.Print vbTab & pshape.Name
            If LCase(Cells(2, titleHeader.ListColumns("Nature of Material*").Index)) <> "4k" And LCase(Cells(2, titleHeader.ListColumns("Nature of Material*").Index)) = "" Then
                pshape.Delete
            End If
        Case "SD"
            Debug.Print vbTab & pshape.Name
        Case "FullHD"
            Debug.Print vbTab & pshape.Name
            Debug.Print vbTab & Cells(2, titleHeader.ListColumns("FullHD").Index)
    End Select
Next

更新1：尝试过（不起作用） 这里可能是什么问题？

Dim countShape as Long
Dim i as Long
countShape = ppres.Slides(1).Shapes.count
For i = 1 to countShape
    Select Case pshape.Name
        Case "HD"
            Debug.Print vbTab & pshape.Name
            pshape.Delete
            i = i - 1
            countShape = countShape - 1
        Case "4K"
            Debug.Print vbTab & pshape.Name
            pshape.Delete
            i = i - 1
            countShape = countShape - 1
        Case "SD"
            Debug.Print vbTab & pshape.Name
        Case "FullHD"
            Debug.Print vbTab & pshape.Name
    End Select
Next i

整数超出范围错误即将到来。我认为countShape不会更新其值。

Answer 1

您需要按索引从头到尾循环遍历形状...

Dim i As Long

With ppres.Slides(1).Shapes
    For i = .Count To 1 Step -1
        Select Case .Item(i).Name
            'etc
            '
            '
        End Select
    Next i
End With