VBA Identification of Connected Shapes in Excel - 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:
Loop through all connector shapes.
Create a Unique collection of shapes to which other shapes are connected with.
Get the Beginning and the Ending shape names.
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: