Association Connectors Text

Started by PhilipLa1, November 10, 2020, 06:03:14 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

PhilipLa1

I'm creating hover text in network diagrams.  I've recently discovered the power of multiple text boxes in Association Connectors. While regular connectors only accommodate one text box. I'm using ACs to give me 4 associated text boxes. It took me quite a while to create a VBA script that gets the names of the shapes that each AC connects to. So I've posted it below: [PS: Works in Visio Standard 2019 .... sorry, I'm not a programmer]
>>>>>>>>>

Public Sub d_VisioAssociationConnectionsHoverText()
'For each end of selected "Association Connectors", identifies the object "Name"  and their respective Port info from the AC text boxes
'Note: The port info is read from the text boxes near the connector ends.
'
Dim vsoConnect As Visio.Connect
Dim vsoConnects As Visio.Connects
Dim vsoSelect As Visio.Selection
Dim vsoShape As Visio.Shape
Dim vsoShapes As Visio.Shapes
'Dim strConnects As String
Dim strAllPorts As String
Dim ConsTextCount As Integer
Dim strFromPorts As String
Dim strToPorts As String
Dim strFromToPorts As String
Dim strTo As String
Dim MyQuotes As String
On Error GoTo 0
'Select all objects in the Association Connectors layer
On Error Resume Next
Set vsoSelect = Application.ActiveWindow.Page.CreateSelection(visSelTypeByLayer, visSelModeSkipSuper, "Association Connectors")
Application.ActiveWindow.Selection = vsoSelect


Set vsoSelect = Visio.ActiveWindow.Selection

If vsoSelect.Count > 0 Then
    'For each shape in the selection, get its connections.
For Each vsoShape In vsoSelect
Set vsoConnects = vsoShape.Connects


    'For each connection, get the shape it connects to.
ConsTextCount = 1



For Each vsoConnect In vsoConnects


'Get the names of the shapes the Connect object connects to.
         
If ConsTextCount = 1 Then strFromPorts = vsoConnect.ToSheet.CellsU("Prop.Name").ResultStr("") & "   " & vsoShape.Shapes(ConsTextCount).Text & Chr$(10)
  If ConsTextCount = 2 Then strToPorts = vsoConnect.ToSheet.CellsU("Prop.Name").ResultStr("") & "   " & vsoShape.Shapes(ConsTextCount).Text
           
    ConsTextCount = 2
Next vsoConnect
strFromToPorts = strFromPorts & strToPorts
Debug.Print strFromToPorts
    'Assign Ports Data To Screen Tip
    'Ports data is copied to the comments field & the resultant screentip is created by Visio from the comments field.
    'We need a cludge to allow varaibles to be used in FormulaU expressions
MyQuotes = """"

vsoShape.Cells("Comment").FormulaU = MyQuotes & strFromToPorts & MyQuotes

Next vsoShape

End If
On Error GoTo 0
End Sub

<<<<<<<<<<<<<<<