Decided to see if there was a simpler way to find connectivity using custom code. Yes... and no.
The code below is much simpler than previous versions, but, it doesn't always get the directionality correct. Specifically, when a connector is glued to another connector, there can be misinformation. But, on the other hand, it does seem to catch all of the connections. Even those that are floating or only have one end connected.
So, for what it's worth, here's the code: (note, output is immediate window, debug.print)
Public Sub GetGluedShapes()
'Use Shape.GluedShapes to get the shapes that are glued to a shape
Dim shp As Visio.Shape
Dim shpIDs() As Long
Dim i As Integer
Debug.Print "GluedShapes"
For Each shp In ActivePage.Shapes
If shp.OneD Then
Debug.Print shp.Name
shpIDs = shp.GluedShapes(visGluedShapesIncoming1D, "")
For i = 0 To UBound(shpIDs)
Debug.Print "Incoming 1D shapes"
Debug.Print ActivePage.Shapes.ItemFromID(shpIDs(i)).Name
Next
shpIDs = shp.GluedShapes(visGluedShapesOutgoing1D, "")
For i = 0 To UBound(shpIDs)
Debug.Print "Outgoing 1D shapes"
Debug.Print ActivePage.Shapes.ItemFromID(shpIDs(i)).Name
Next
shpIDs = shp.GluedShapes(visGluedShapesIncoming2D, "")
For i = 0 To UBound(shpIDs)
Debug.Print "Incoming 2D shapes"
Debug.Print ActivePage.Shapes.ItemFromID(shpIDs(i)).Name
Next
shpIDs = shp.GluedShapes(visGluedShapesOutgoing2D, "")
For i = 0 To UBound(shpIDs)
Debug.Print "Outgoing 2D shapes"
Debug.Print ActivePage.Shapes.ItemFromID(shpIDs(i)).Name
Next
End If
Debug.Print ""
Next
End Sub
Updated file/code.
Based upon another, recent post, I realized that this post needed an update. I believe that there is even a more simpler coding solution...the simplest solution if you will.
This is for all shapes on a page and doesn't require, but will work with Connection points with named rows. That is, it refers to the shapes and not their literal connections. The code:
Public Sub NotNamedRowListGluedConnections()
'Code 1st lists connector, then shows, if any, incoming and outgoing shapes
'
Dim shp As Visio.Shape
Dim connectorShape As Visio.Shape
Dim sourceShape As Visio.Shape
Dim targetShape As Visio.Shape
Dim aryTargetIDs() As Long
Dim arySourceIDs() As Long
Dim targetID As Long
Dim sourceID As Long
Dim i As Integer
Dim vCon As Connect
Dim typeSkip As Boolean
typeSkip = False
For Each shp In Visio.ActivePage.Shapes
If shp.OneD Then
For Each vCon In shp.Connects
If Not typeSkip Then
Debug.Print "Connector:"; shp.Name
Debug.Print "Source End:", vCon.ToSheet.Name
typeSkip = True
Else
If shp.Connects.Count < 2 Then
` Debug.Print "Connector", shp.Name
End If
Debug.Print "Receive End:", vCon.ToSheet.Name
typeSkip = False
End If
Next
Debug.Print ""
End If
Next
End Sub
Here's "simplest" version that catches named row in either the incoming/outgoing 2D shape attached to the connector.
Public Sub NamedRowListGluedConnections()
'Code 1st lists connector, then shows, if any, incoming and outgoing shapes
'
Dim shp As Visio.Shape
Dim connectorShape As Visio.Shape
Dim sourceShape As Visio.Shape
Dim targetShape As Visio.Shape
Dim aryTargetIDs() As Long
Dim arySourceIDs() As Long
Dim targetID As Long
Dim sourceID As Long
Dim i As Integer
Dim vCon As Connect
Dim typeSkip As Boolean
typeSkip = False
For Each shp In Visio.ActivePage.Shapes
If shp.OneD Then
For Each vCon In shp.Connects
If Not typeSkip Then
Debug.Print "Connector: "; shp.Name, shp.Text 'vCon.FromSheet, vCon.FromSheet.Text
Debug.Print "Source shape: ", vCon.ToSheet.Name, vCon.ToCell.RowName
typeSkip = True
Else
If shp.Connects.Count < 2 Then
Debug.Print "Connector: ", shp.Name, shp.Text
End If
Debug.Print "Receive shape: ", vCon.ToSheet.Name, vCon.ToCell.RowName; ""
typeSkip = False
End If
Next
Debug.Print ""
End If
Next
End Sub