Sub Realer_Irrsinn()
Dim Shp As Shape
Dim Tbx As Shape
Dim CC As ContentControl
With ActiveDocument
For i = 1 To .Shapes.Count
Debug.Print "--- Shape " & i & vbCrLf
If .Shapes(i).Type = msoCanvas Then
Set Shp = .Shapes(i)
For j = 1 To Shp.CanvasItems.Count
If Shp.CanvasItems(j).Type = msoTextBox Then
Set Tbx = Shp.CanvasItems(j)
For k = 1 To Tbx.TextFrame.TextRange.ContentControls.Count
With Tbx.TextFrame.TextRange.ContentControls(k)
Debug.Print .Title, .Tag
End With
Next k
End If
Debug.Print Chr(13), "-------------", "next Canvas", j, vbCrLf
Next j
End If
If .Shapes(i).Type = msoTextBox Then
Set Tbx = .Shapes(i)
For k = 1 To Tbx.TextFrame.TextRange.ContentControls.Count
With Tbx.TextFrame.TextRange.ContentControls(k)
Debug.Print .Title, .Tag
End With
Next k
End If
Next i
End With
End Sub