Iterate through all slides and get the count of characters in powerpoint

Question

I have a script to loop through only one slide and get the text written in the shape

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

However, I want to loop through all slides and get the count of characters from shapes and placeholders of all slides

Hope the code can be tweaked with redim preserve array but i get an error.

Am looking for a script which gives me message with count of characters in all slides

Please help me on the same.

Answer 1

try nested for-each:

For Each slide In ActivePresentation.Slides
    For Each thisShape In slide.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
Next slide