Reading text from grouped shapes

[John Svendsen]

Hi,

I need to read ALL text within shapes. I've created a macro to do this, but
when there are GROUPED SHAPES in a slide, this macro fails.
Can somebody give me an idea why, and what to do?
Thanks so much, JS

Sub ReadText()
Dim shp As Shape
Dim sld As Slide
Dim SldNum As Long
Open "C:\Text-in-shapes.txt" For Output As #1
On Error Resume Next
SldNum = 0
For Each sld In Application.ActivePresentation.Slides
'
' Tried ot ungrou with this code, but no go...
'
ActiveWindow.Selection.SlideRange.Shapes.SelectAll
ActiveWindow.Selection.ShapeRange.Ungroup.Select
ActiveWindow.Selection.Unselect
'
SldNum = SldNum + 1
Print #1, "[Slide=" & SldNum & "]"
For Each shp In sld.Shapes
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
Print #1, shp.TextFrame.TextRange
End If
End If
Next shp
Next sld
Print #1, "[#end#]"
Close #1
End Sub

 

[Steve Rindsberg]

Hi,

I need to read ALL text within shapes. I've created a macro to do this, but
when there are GROUPED SHAPES in a slide, this macro fails.
Can somebody give me an idea why, and what to do?

Why: groups don't have text frames so can't contain text; the shapes within
the group might have text frames. You need a way to get at them instead.

Study this example for one approach (this recolors the text, but with a few
mods, it could give you the text itself)

http://skp.mvps.org/pptxp006.htm

Sub ReadText()
Dim shp As Shape
Dim sld As Slide
Dim SldNum As Long
Open "C:\Text-in-shapes.txt" For Output As #1
On Error Resume Next
SldNum = 0
For Each sld In Application.ActivePresentation.Slides
'
' Tried ot ungrou with this code, but no go...
'
ActiveWindow.Selection.SlideRange.Shapes.SelectAll
ActiveWindow.Selection.ShapeRange.Ungroup.Select
ActiveWindow.Selection.Unselect
'
SldNum = SldNum + 1
Print #1, "[Slide=" & SldNum & "]"
For Each shp In sld.Shapes
If shp.HasTextFrame Then
If shp.TextFrame.HasText Then
Print #1, shp.TextFrame.TextRange
End If
End If
Next shp
Next sld
Print #1, "[#end#]"
Close #1
End Sub