Opløsning af grupperinger af og i tekstbokse

Jeg har fået følgende kode af rvm, og den virker fint til pille tekst ud af tekstbokse, men jeg er så stødt på det problem at visse af tekstboksene er en del af en større gruppering, som først skal regroupes, ligeledes kan det forekomme at tekstboksen indeholder yderligere grupperinger. Så findes der en måde at løse grupperingerne samtidig med at teksten trækkes ud??
Hvis der forekommer en ikke opløst gruppering stopper makroen i følgende linie:
Indhold = ashape.TextFrame.TextRange.Text

Sub HentFraTekstbokse()

Dim ashape As Shape, Findwhat As String, Replacewith As String

Dok = ActiveDocument.Name

Application.Documents.Add

DokNyt = ActiveDocument.Name

Application.Documents(Dok).Activate

For Each ashape In ActiveDocument.Shapes
      Indhold = ashape.TextFrame.TextRange.Text
      længde = Len(Indhold)
      Indhold = Mid(Indhold, 1, længde - 1)
     
      Application.Documents(DokNyt).Activate
      Selection.TypeText Indhold
      Selection.TypeParagraph
      Application.Documents(Dok).Activate
Next

End Sub































Sub HentFraTekstbokse()

Dim ashape As Shape, Findwhat As String, Replacewith As String

Dok = ActiveDocument.Name

Application.Documents.Add

DokNyt = ActiveDocument.Name

Application.Documents(Dok).Activate

For Each ashape In ActiveDocument.Shapes
      Indhold = ashape.TextFrame.TextRange.Text
      længde = Len(Indhold)
      Indhold = Mid(Indhold, 1, længde - 1)
     
      Application.Documents(DokNyt).Activate
      Selection.TypeText Indhold
      Selection.TypeParagraph
      Application.Documents(Dok).Activate
Next

End Sub