Option Explicit
Public Function GetTree(ByVal Worksheet As Excel.Worksheet, ByRef Root As TreeItem) As Long
Dim dicTI As Scripting.Dictionary
Dim shp As Excel.Shape
Set dicTI = New Scripting.Dictionary
For Each shp In Worksheet.Shapes
If shp.Connector Then
With shp.ConnectorFormat
If .BeginConnected Then
If Not dicTI.Exists(.BeginConnectedShape.Name) Then
Set dicTI(.BeginConnectedShape.Name) = New TreeItem
Set dicTI(.BeginConnectedShape.Name).Shape = .BeginConnectedShape
End If
End If
If .EndConnected Then
If Not dicTI.Exists(.EndConnectedShape.Name) Then
Set dicTI(.EndConnectedShape.Name) = New TreeItem
Set dicTI(.EndConnectedShape.Name).Shape = .EndConnectedShape
End If
End If
If dicTI(.EndConnectedShape.Name).LeftChild Is Nothing Then
Set dicTI(.EndConnectedShape.Name).LeftChild = dicTI(.BeginConnectedShape.Name)
Else
Set dicTI(.EndConnectedShape.Name).RightChild = dicTI(.BeginConnectedShape.Name)
End If
If dicTI(.BeginConnectedShape.Name).Parent Is Nothing Then
Set dicTI(.BeginConnectedShape.Name).Parent = dicTI(.EndConnectedShape.Name)
End If
End With
End If
Next
Set Root = GetRoot(dicTI)
GetTree = dicTI.Count
End Function
Private Function GetRoot(TreeItems As Scripting.Dictionary) As TreeItem
Dim objItem As TreeItem
Set objItem = TreeItems(TreeItems.Keys()(0))
Do Until objItem.Parent Is Nothing
Set objItem = objItem.Parent
Loop
Set GetRoot = objItem
End Function