Get texts of Organogram SmartArt in VBA

Question

I would to get the texts of an Smart Art organogram to vba.

Like, in the following photo, I would like to get "Text", "Text1", "Text2" and "Text3" and know how they're positioned in the hierarchy.

I couldn't find anything related on the internet. Is it possible? If so, how can I do it? Thanks in advance for helping.

Answer 1

Microsoft documentation:

SmartArt.AllNodes property (Office)

Shape.HasSmartArt property (PowerPoint)

Option Explicit
Sub GetOrganogramText()
    Dim shapeIndex As Long
    Dim objSArt As SmartArt
    Dim objNode As SmartArtNode
    With ActiveSheet
        For shapeIndex = 1 To .Shapes.Count
            If .Shapes(shapeIndex).HasSmartArt Then
                Set objSArt = .Shapes(shapeIndex).SmartArt
                If objSArt.Layout.Category = "hierarchy" Then
                    For Each objNode In objSArt.AllNodes
                        Debug.Print "Level: " & objNode.Level & vbTab & "Text: " _
                                & objNode.TextFrame2.TextRange.Text
                    Next objNode
                End If
            End If
        Next shapeIndex
    End With
End Sub

Output:

Level: 1    Text: A1
Level: 2    Text: AA2
Level: 3    Text: DD3
Level: 2    Text: BB2
Level: 2    Text: CC2
Level: 3    Text: EE3
Level: 4    Text: FF4

---

Update:

Question: How can I know which is father of DD3? "AA2", "CC2" or "BB2"

Option Explicit
Sub GetParentNode()
    Dim shapeIndex As Integer
    Dim objSArt As SmartArt
    Dim objNode As SmartArtNode
    Const TARGET_NODE = "DD3"
    With ActiveSheet
        For shapeIndex = 1 To .Shapes.Count
            If .Shapes(shapeIndex).HasSmartArt Then
                Set objSArt = .Shapes(shapeIndex).SmartArt
                If objSArt.Layout.Category = "hierarchy" Then
                    For Each objNode In objSArt.AllNodes
                        If objNode.TextFrame2.TextRange.Text = TARGET_NODE Then
                            Debug.Print "Parent node is " _
                                & objNode.ParentNode.TextFrame2.TextRange.Text
                        End If
                    Next objNode
                End If
            End If
        Next shapeIndex
    End With
End Sub