CODEWITHSUNDEEP
vbavisio
Jeame
Jeame

Reputation: 49

VBA in MS Visio - highlighting connectors of selected shape

After selecting a shape (f.e. square or more squares) all the connectors glued to this shape would highlight red, yellow whatever. The found code below is not working for me, any advice? (I am not coder, so please have patience with me)

Set shpAtEnd = cnx(1).ToSheet
' use HitTest to determine whether Begin end of connector
' is outside shpAtEnd
x = shpAtEnd.HitTest(shpTaskLink.Cells("BeginX"), _
shpTaskLink.Cells("BeginY"), 0.01)

If x = visHitOutside Then
    Selection.ShapeRange.Fill.ForeColor.SchemeColor = 2
Else
    ' do other stuff
End If

Upvotes: 2

Views: 3456

Answers (2)

Chelsea
Chelsea

Reputation: 21

This is my first answer on stackoverflow and I hope the following VBA code can solve your problem on how to highlight connectors or connected shapes in Visio!

Public Sub HighlightConnectedShapes()

    Dim vsoShape As Visio.Shape
    Dim connectedShapeIDs() As Long
    Dim connectorIDs() As Long
    Dim intCount As Integer

    ' Highlight the selected shape
    Set vsoShape = ActiveWindow.Selection(1)
    vsoShape.CellsU("Fillforegnd").FormulaU = "RGB(146, 212, 0)"
    vsoShape.Cells("LineColor").FormulaU = "RGB(168,0,0)"
    vsoShape.Cells("LineWeight").Formula = "2.5 pt"

     ' Highlight connectors from/to the selected shape
    connectorIDs = vsoShape.GluedShapes _
      (visGluedShapesAll1D, "")
    For intCount = 0 To UBound(connectorIDs)
        ActivePage.Shapes.ItemFromID(connectorIDs(intCount)).Cells("LineColor").FormulaU = "RGB(168,0,0)"
        ActivePage.Shapes.ItemFromID(connectorIDs(intCount)).Cells("LineWeight").Formula = "2.5 pt"
    Next

    ' Highlight shapes that are connected to the selected shape
    connectedShapeIDs = vsoShape.connectedShapes(visConnectedShapesAllNodes, "")
    For intCount = 0 To UBound(connectedShapeIDs)
        ActivePage.Shapes.ItemFromID(connectedShapeIDs(intCount)).Cells("LineColor").FormulaU = "RGB(168,0,0)"
        ActivePage.Shapes.ItemFromID(connectedShapeIDs(intCount)).Cells("LineWeight").Formula = "2.5 pt"
    Next

End Sub

To run the macro, you can consider associating with double-click behavior of shapes.

If you only need to highlight incoming/outgoing connectors and incoming/outgoing shapes, replace visGluedShapesAll1D with visGluedShapesIncoming1D/visGluedShapesOutgoing1D and visConnectedShapesAllNodes with visConnectedShapesIncomingNodes/visConnectedShapesOutgoingNodes.

Learn more at visgluedshapesflags and visconnectedshapesflags. Good luck!

Upvotes: 2

L8n
L8n

Reputation: 728

The following code will loop though all 1d-Shapes glued to the first shape in your Selection and write their name to the Immediate window. This should be a good starting point.

Visio has no Event that fires if a Shape is selected (at least not without some workarounds), so maybe bind the macro to a keybind.

The visGluedShapesAll1D flag can be replace with another filter as described here: Microsoft Office Reference

Sub colorConnectors()

    If ActiveWindow.Selection(1) Is Nothing Then Exit Sub

    Dim selectedShape   As Shape
    Set selectedShape = ActiveWindow.Selection(1)

    Dim pg   As Page
    Set pg = ActivePage


    Dim gluedConnectorID As Variant 'variant is needed because of "For Each" Loop

    For Each gluedConnectorID In selectedShape.GluedShapes(visGluedShapesAll1D, "")
        Debug.Print pg.Shapes.ItemFromID(gluedConnectorID).NameU
    Next gluedConnectorID

End Sub

Upvotes: 0

Related Questions