Reading text in grouped objects - vba

Question

I made a presentation (with Powerpoint 2016 in Windows 10) on which there are text attached to the images.
I know VBA (not thoroughly) for Word or Excel but I'm new to PP. But Powerpoint grammar confuses me (it will also be for my age). I want to extract all the title and text of all the slides and about this I create the following program which works fine but doesn't let me know the text on grouped objects. Where am I wrong?
Sub RiepilogaConWord()
Dim applWord As Word.Application
Dim docWord As Word.Document
Dim paraWord As Word.Paragraph
Dim oSh As Shape
Dim oSL As Slide
Set applWord = New Word.Application
applWord.Visible = True
applWord.WindowState = wdWindowStateMaximize
Set docWord = applWord.Documents.Add
docWord.ShowSpellingErrors = False
applWord.Selection.TypeText Text:="RIEPILOGO AL " & Format(Date, "dd/mm/YYYY") & " alle ore " & Format(Time, "hh:mm")
docWord.Paragraphs.Add
Set paraWord = docWord.Paragraphs(docWord.Paragraphs.Count)
paraWord.Range.InsertAfter "Totale diapositive " & Presentations(1).Slides.Count
docWord.Paragraphs.Add
For Each oSL In ActivePresentation.Slides
paraWord.Range.InsertAfter oSL.SlideIndex
docWord.Paragraphs.Add
Dim g As Integer
For Each oSh In oSL.Shapes
Select Case oSh.Type
Case Is = msoGroup
On Error Resume Next
oSh.Ungroup.Group , msoTextBox
For g = 1 To oSh.GroupItems.Count
If oSh.TextFrame.HasText Then
paraWord.Range.InsertAfter oSh.Name & ":= " & oSh.TextFrame.TextRange
End If
Next g
On Error GoTo errorhandler
Case Else
With oSh
If .HasTextFrame Then
If .TextFrame.HasText Then
paraWord.Range.InsertAfter oSh.Name & ":= " & .TextFrame.TextRange
End If
End If
End With
End Select
Next
Next
docWord.SaveAs FileName:="C:\EPITETI CINQUE\Presentazione\RiepilogoPresentazione"
applWord.Quit
Set docWord = Nothing
Set applWord = Nothing
Set paraWord = Nothing
Exit Sub
errorhandler:
End Sub
Thank you for any help.
Francesco

Answer 1

Couple of things at issue here
On Error Resume Next is hiding the issue from you. Remove it
oSh.Ungroup.Group , msoTextBox makes no sense, I don't know what you are trying to do there
When you find a grouped object, iterate its members
I've refactored your code to demonstrate.
I've removed the Word stuff to make the Q clearer, and just dump the text to the Immediate Window (Ctrl-G to display it in the VBA editor). You can add it back...
added comments on changed code, marked <---
Added indenting to make the code readable
Sub RiepilogaConWord()
Dim oSh As Shape
Dim oSL As Slide
Dim g As Integer '<--- move here, no point in putting it in the loop, that does nothing
'<--- Add here to use a general error.
' Comment it out while debugging to expose any errors
' On Error GoTo errorhandler handler
For Each oSL In ActivePresentation.Slides
For Each oSh In oSL.Shapes
Select Case oSh.Type
Case Is = msoGroup
'On Error Resume Next '<--- Delete this
'oSh.Ungroup.Group , msoTextBox '<--- Delete this
For g = 1 To oSh.GroupItems.Count
With oSh.GroupItems.Item(g) '<--- simplify
'<--- use g to iterate the grouped items
If .HasTextFrame Then '<--- more robust
If .TextFrame.HasText Then
Debug.Print .Name & ":= " & .TextFrame.TextRange
End If
End If
End With
Next g
'On Error GoTo errorhandler '<--- Delete this
Case Else
With oSh
If .HasTextFrame Then
If .TextFrame.HasText Then
Debug.Print oSh.Name & ":= " & .TextFrame.TextRange
End If
End If
End With
End Select
Next
Next
Exit Sub
errorhandler:
End Sub