CODEWITHSUNDEEP
excelvbapowerpoint
Vinod Bokde
Vinod Bokde

Reputation: 338

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

I'm lopping through the shapes in Slide 1 of Powerpoint

When Shape with name "HD" gets deleted next shape is becoming "SD" skipping "4K". And if "4K" is deleted then next shape is becoming "FullHD"

how to avoide this?

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

Update 1: Tried (Not Working) What could be the problem here ?

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

Integer Out of Range Error is coming. I think countShape is not updating it's value.

Upvotes: 1

Views: 216

Answers (1)

Domenic
Domenic

Reputation: 8104

You'll need to loop through your shapes by index and from last to first...

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

Upvotes: 5

Related Questions