vbapowerpointtransparencytextrange

Powerpoint VBA foreach skipping some valid shapes


I do presentations with background wipes that are flowchart process shapes with the text "wipey" for yellow wipes and "wipeb" for blue wipes. When working out the animations for training slides, I place the wipes in front with 0.75 transparency. Once the wipe-animation order is correct and the wipes properly placed, I move the wipes behind the text with 0 transparency. My Wipe_Back macro works fine but my Wipe_Front macro is only getting some of the wipes each time it is called. I have to call it multiple times to get all of the shapes moved forward. the macros are almost identical so I am not sure what I am doing wrong, but I am a VBA newbie-ish! both macros are shown below and I am also open to recommendations on more elegant practices in the code.

Wipe_Back (seems to work):

Sub Wipe_Back()
  Dim sld As slide
  Dim shp As Shape
  Dim str As String
  For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes
        If shp.Type = msoAutoShape Then
            If shp.HasTextFrame Then
              If shp.TextFrame.TextRange = "wipey" Then
                shp.Fill.Transparency = 0
                shp.ZOrder msoSendToBack
                'shp.Fill.Transparency = 0.75
                'shp.ZOrder msoBringToFront
              End If
              If shp.TextFrame.TextRange = "wipeb" Then
                shp.Fill.Transparency = 0
                shp.ZOrder msoSendToBack
                'shp.Fill.Transparency = 0.75
                'shp.ZOrder msoBringToFront
              End If
            End If
        End If
    Next shp
  Next sld
End Sub

Wipe_Front does not consistently work:

Sub Wipe_Front()
  Dim sld As slide
  Dim shp As Shape
  Dim str As String
  For Each sld In ActivePresentation.Slides
    For Each shp In sld.Shapes
        If shp.Type = msoAutoShape Then
            If shp.HasTextFrame Then
              If shp.TextFrame.TextRange = "wipey" Then
                'shp.Fill.Transparency = 0
                'shp.ZOrder msoSendToBack
                shp.Fill.Transparency = 0.75
                shp.ZOrder msoBringToFront
              End If
              If shp.TextFrame.TextRange = "wipeb" Then
                'shp.Fill.Transparency = 0
                'shp.ZOrder msoSendToBack
                shp.Fill.Transparency = 0.75
                shp.ZOrder msoBringToFront
              End If
            End If
        End If
    Next shp
  Next sld
End Sub

Solution

  • If you change the order of shapes (as changing the z-order does) or delete them in the midst of a For Each/Next loop, the results won't be what you expect.

    If deleting shapes, you can use something like this:

    For x = sld.Shapes.Count to 1 Step -1 ' delete sld.Shapes(x) if it meets your conditions Next

    If changing the z-order, you may need to collect references to the shapes in an array and step through the array a shape at a time.