VBA PowerPoint: Get all shapes with text

12,408

For Each thisShape In allShapes

What is allShapes? Is it declared somewhere?

Also to preserve the shapes in the array you have to use Redim Preserve

Is this what you are trying? This loops thorough all the shapes in Slide 1.

Sub Sample()
    Dim textShapes() As Shape, i as Long

    ReDim textShapes(0 To 2)

    i = 0

    For Each thisShape In ActivePresentation.Slides(1).Shapes
        If thisShape.HasTextFrame Then
            If thisShape.TextFrame.HasText Then
               Set textShapes(i) = thisShape
               i = i + 1
               ReDim Preserve textShapes(0 To i) As Shape
            End If
         End If
    Next thisShape

    Debug.Print textShapes(1).TextFrame.TextRange.Text
End Sub

Also as the title of the question say Get all shapes with text; In such a case you will have to loop through the array. to get all shapes with text.

Share:
12,408
JoshDG
Author by

JoshDG

Updated on June 04, 2022

Comments

  • JoshDG
    JoshDG almost 2 years

    Can't quite figure out what's going wrong here. I get a object variable not set for the last debug.print line. N.B - the debug.print line in the loop prints fine and there are three shaped that should be in the array (and i is at 3 at the end of the loop). I think I may just not understand exactly how arrays / variable setting works, I'm new to VBA (I do have programming experience though).

    Dim allShapes As Shapes
    Set allShapes = ActivePresentation.Slides(11).Shapes
    Dim textShapes() As Shape
    ReDim textShapes(0 To 2)
    i = 0
    
    For Each thisShape In allShapes
        If thisShape.HasTextFrame Then
            If thisShape.TextFrame.HasText Then
               Debug.Print thisShape.TextFrame.TextRange.Text
               Set textShapes(i) = thisShape
               i = i + 1
    
               ReDim textShapes(0 To i) As Shape
            End If
    
         End If
    Next thisShape
    ReDim textShapes(0 To i - 1)
    
    Debug.Print textShapes(1).TextFrame.TextRange.Text