VBA Identification of Connected Shapes in Excel

Question

I am trying to develop a VBA solution within Excel that can identify which shapes are connected to eachother within a worksheet via a standard connector line.

For example, in the snippet attached, I need to create a code that can identify that the control square is connected to the two red circles (titled Risk 1 and Risk 2) and output the following in a message box: "Risk 1 and Risk 2 are connected to Control". I have been able to find code to add connector lines however I cannot figure out how to identify connected shapes. Any guidance would be greatly appreciated! I have also attached the code that I have been able to find thus far.

Sub QuickConnect( )
    Dim s1 As Shape, s2 As Shape, conn As Shape
    
    ' Create a shape
    Set s1 = ActiveSheet.Shapes.AddShape(msoShapeCube, 100, 10, 50, 60)
    
    ' Create another shape
    Set s2 = ActiveSheet.Shapes.AddShape(msoShapeCan, 50, 100, 50, 60)

    ' Create connector with arbitrary coordinates
    Set conn = ActiveSheet.Shapes.AddConnector(msoConnectorCurve, 1, 1, 1, 1)

    ' Connect shapes
    conn.ConnectorFormat.BeginConnect s1, 1
    conn.ConnectorFormat.EndConnect s2, 1
    
    ' Connect via shortest path (changes connection sites)
    conn.RerouteConnections
End Sub

Answer 1

Therefore you need to loop through all shapes, check if they are a connector (yes, connector lines are shapes too). And then you can check which shapes are connected by this connector line:

The property .ConnectorFormat.BeginConnectedShape gives you the shape at one end of the connector line and .ConnectorFormat.EndConnectedShape the shape on the other end.

Checkout this:

Option Explicit

Public Sub TestConnections()
    Dim shp As Variant
    For Each shp In Shapes 'loop through all shapes            
        If shp.Connector = msoTrue Then 'check if current shape is a connector
            'BeginConnectedShape is the shape on the beginning side of the connector
            'EndConnectedShape is the shape on the ending side of the connector
            Debug.Print shp.Name _
                        & " connects " & _
                        shp.ConnectorFormat.BeginConnectedShape.Name _
                        & " with " & _
                        shp.ConnectorFormat.EndConnectedShape.Name
        End If
    Next shp 
End Sub

For the following shapes

it outputs

Curved Connector 3 connects Cube 1 with Can 2
Curved Connector 6 connects Cube 5 with Can 2

Answer 2

You can use ConnectorFormat.EndConnectedShape property (Excel) and ConnectorFormat.BeginConnectedShape property (Excel) to achieve what you want.

LOGIC:

1. Loop through all connector shapes.
2. Create a Unique collection of shapes to which other shapes are connected with.
3. Get the Beginning and the Ending shape names.
4. Find the relation i.e WHO is connected to WHO.

CODE:

I have commented the code but if you still have questions then feel free to ask.

Option Explicit

'~~> Change this if your shapes include the below text
Const mySep As String = "MySep"

Sub Sample()
    Dim ws As Worksheet
    Dim shpConnector As Shape
    Dim shpConnectorCount As Long
    Dim i As Long: i = 1
    Dim tmpAr As Variant, itm As Variant
    Dim colConnector As New Collection
    Dim msg As String
    Dim finalOutput As String
    
    '~~> Change this to the relevant sheet
    Set ws = Sheet1
    
    With ws
        '~~> Count the number of connector shapes
        For Each shpConnector In .Shapes
            If shpConnector.Connector Then shpConnectorCount = shpConnectorCount + 1
        Next shpConnector
        
        '~~> If not found then exit sub
        If shpConnectorCount = 0 Then Exit Sub
        
        '~~> Resize array based on connector count
        ReDim tmpAr(1 To shpConnectorCount)
        
        For Each shpConnector In .Shapes
            With shpConnector
                If .Connector Then
                    '~~> Unique collection of shapes to which other
                    '~~> shapes are connected with
                    On Error Resume Next
                    colConnector.Add CStr(.ConnectorFormat.EndConnectedShape.Name), _
                    CStr(.ConnectorFormat.EndConnectedShape.Name)
                    On Error GoTo 0
                    
                    '~~> Store Starting shape and End Shape in an array
                    tmpAr(i) = .ConnectorFormat.BeginConnectedShape.Name & mySep _
                    & .ConnectorFormat.EndConnectedShape.Name
                    i = i + 1
                End If
            End With
        Next
        
        '~~> Loop through the unique collection and the array to create
        '~~> Our necessary output
        For Each itm In colConnector
            msg = ""
            For i = LBound(tmpAr) To UBound(tmpAr)
                If Split(tmpAr(i), mySep)(1) = itm Then
                    msg = msg & "," & Split(tmpAr(i), mySep)(0)
                End If
            Next i
            finalOutput = finalOutput & vbNewLine & Mid(msg, 2) & " is/are connected to " & itm
        Next itm
    End With
    
    MsgBox Mid(finalOutput, 2)
End Sub

IN ACTION:

SCREENSHOT: