Highlighting Layers via Code

[Qelliott]

I'm presently preparing a diagram of sorts and thus far the code has gone swimmingly, until now. I've been able to achieve "hide all" and "show all" as well as showing isolated layers and hiding the rest with the: Call ShowLayers("loadlist") for instance. Problem is I'm learning as I go, the book I have needs to be tossed, and I'm trying to do something that I'm not entirely sure visio supports. Instead of showing just one layer or step in the process isolated from everything else (when the commandbutton is clicked) can I simply highlight or stroke the layer with a certain color? To complicate things I have one database object that is in several layers, so that may present an issue if this is even possible. sample code is below.

Thanks for taking time to read this!

Q

sample::

Code Select Expand



Private Sub ShowLayers(ThisLayer)
Dim LayersObj As Visio.Layers
Dim LayerObj As Visio.Layer
Dim LayerName As String
Dim LayerCellObj As Visio.Cell
Set LayersObj = ActivePage.Layers
For Each LayerObj In LayersObj
LayerName = LayerObj.Name
' Debug.Print LayerName
  If LayerName = ThisLayer Or LayerName = "Connector" Then
    Set LayerCellObj = LayerObj.CellsC(visLayerVisible)
    LayerCellObj.Formula = True
  Else
    Set LayerCellObj = LayerObj.CellsC(visLayerVisible)
    LayerCellObj.Formula = False
  End If
Next
End Sub
Private Sub AllLayers(OnOrOff)
Dim LayersObj As Visio.Layers
Dim LayerObj As Visio.Layer
Dim LayerName As String
Dim LayerCellObj As Visio.Cell
Set LayersObj = ActivePage.Layers
For Each LayerObj In LayersObj
LayerName = LayerObj.Name
    Set LayerCellObj = LayerObj.CellsC(visLayerVisible)
    LayerCellObj.Formula = OnOrOff
Next
End Sub

Private Sub CommandButton1_Click()
Call ShowLayers("loadlist")
End Sub


[Visio Guy]

Hi QE,

This is a little snippet that will color a layer red:

Dim visPg as Visio.Page
Dim visLyr as Visio.Layer

Set visPg = Visio.ActivePage

Set visLyr = visPg.Layers("Bob")

visLyr.CellsC(visio.VisCellIndices.visLayerColor).Formula = "RGB(255,0,0)"

You can clear the layer coloring by wiping the formula clean:

visLyr.CellsC(visio.VisCellIndices.visLayerColor).Formula = ""

Or by setting the result to 0:

visLyr.CellsC(visio.VisCellIndices.visLayerColor).ResultIU = 0

[Qelliott]

Most excellent! I just wanted to take some time here to thank you for your prompt response on this issue. I've come to really love the Visio program and I will be using this with all my customers (Mac and PC). Good to know that such an involved community exists to help each other out and hopefully, one day I can steer someone in the right direction or help with a bit of code. Many thanks again! 

[aledlund]

Sometimes it may be necessary to take an extra step to ensure that when we move shapes between layers, that they reflect the color of the layer we move them to...
HTH
al

Code Select Expand



' this is where we set it up so that the outline color reflects the layer selected
' we end up forcing the line style and color just so the object is aware......
' since layer color affects lines and if the shape is a group the top shape may
' not have lines that we can alter, so move into subshapes to make it happen

Private Sub MakeLayerAware(visShape As Visio.Shape)

        Dim shpCell As Visio.Cell
        Dim visEmbShape As Visio.Shape

        Set shpCell = visShape.CellsSRC(Visio.visSectionObject, visRowLine, visLineColor)
        shpCell.Formula = visBlack
        Set shpCell = visShape.CellsSRC(Visio.visSectionObject, visRowLine, visLinePattern)
        shpCell.Formula = visSolid
            If visShape.Type = visTypeGroup Then
                'Debug.Print "it is a group"
                Set visEmbShape = visShape.Shapes(1)
                'Debug.Print "instantiate an embedded shape"
                Set shpCell = visEmbShape.CellsSRC(Visio.visSectionObject, visRowLine, visLineColor)
                shpCell.Formula = visBlack
                Set shpCell = visEmbShape.CellsSRC(Visio.visSectionObject, visRowLine, visLinePattern)
                shpCell.Formula = visSolid
                ' how wide to make the line
                Set shpCell = visEmbShape.CellsSRC(Visio.visSectionObject, visRowLine, visLineWeight)
                shpCell.Formula = 0.01
            End If


End Sub