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

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

Powerpoint VBA, Shape deletion during For Each loop skips next item

excel

powerpoint

vba