2

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
Mathieu Guindon
  • 69,817
  • 8
  • 107
  • 235
Jeame
  • 49
  • 1
  • 6
  • Not a correct answer to your question, but very similar to your request: http://visguy.com/vgforum/index.php?topic=6012.0 – y4cine Oct 31 '18 at 11:26

2 Answers2

2

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!

Chelsea
  • 21
  • 4
0

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
L8n
  • 728
  • 1
  • 5
  • 15
  • When I select an object and run macro, nothing happens. Could you please advise? (I somehow also pressed "solved" button when I was on my phone) – Jeame Oct 29 '18 at 19:12
  • Is your Immediate Window open? Are there any 1d Shapes connected? This piece of code only displays the name of all connected shapes, it changes nothing on the page. – L8n Oct 30 '18 at 07:28
  • when I clicked on one particular shape, then it popped up the runtime error. Clicked on debug button, it highlighted the yellow line Set vsoShape = ActiveWindow.Selection(1) . When I double clicked on other shapes, it didn't do anything. – CBLT Dec 27 '21 at 15:42