Skip to content

Instantly share code, notes, and snippets.

@Kline-
Last active October 11, 2022 15:18
Show Gist options
  • Save Kline-/cdde62c2c1ca1a38acf7179bca24c5fe to your computer and use it in GitHub Desktop.
Save Kline-/cdde62c2c1ca1a38acf7179bca24c5fe to your computer and use it in GitHub Desktop.
Visio multi-layer visibility toggle
' Visio objects attached to more than one layer will stay visible as long as any layer they are a member of is visible.
' This was undesireable behavior for the drawing I was creating and this is the solution I came up with. Suggestions and
' improvements are welcome as I rarely touch VBA code and prior to last week had only ever used Visio for about 5 minutes :)
' The ToggleLayer sub will toggle the visibility of a named layer in Visio. After updating the layer visibility it
' then calls the UpdateShapes sub to iterate through all objects and show/hide them by setting
' Geometry1.NoShow and Misc.HideText values based on the layer visibility.
Option Explicit
Public Sub ToggleLayer(lName As String)
Dim PagObj As Visio.Page
Dim layersObj As Visio.Layers, layerObj As Visio.Layer, layerCell As Visio.Cell
For Each PagObj In ActiveDocument.Pages
Set layersObj = PagObj.Layers
For Each layerObj In layersObj
If layerObj.Name = lName Then
Set layerCell = layerObj.CellsC(visLayerVisible)
If layerCell.Formula = False Or 0 Then
layerCell.Formula = True
UpdateShapes lName, False
Else
layerCell.Formula = False
UpdateShapes lName, True
End If
End If
Next layerObj
Next PagObj
End Sub
Public Sub UpdateShapes(lName As String, hidden As Boolean)
Dim PagObj As Visio.Page
Dim layerObj As Visio.Layer
Dim shpsObj As Visio.Shapes, shpObj As Visio.Shape, shpCell As Visio.Cell
Dim I As Long, N As Long
For Each PagObj In ActiveDocument.Pages
For Each shpObj In PagObj.Shapes
N = shpObj.LayerCount
If N > 0 Then
For I = 1 To N
Set layerObj = shpObj.Layer(I)
If layerObj.Name = lName Then
Set shpCell = shpObj.CellsSRC(visSectionFirstComponent, 0, 2)
shpCell.FormulaU = hidden
Set shpCell = shpObj.CellsSRC(visSectionObject, visRowMisc, visHideText)
shpCell.FormulaU = hidden
End If
Next I
End If
Next shpObj
Next PagObj
End Sub
Private Sub Button1_Click()
ToggleLayer "Routers"
End Sub
@ebeng
Copy link

ebeng commented Dec 22, 2021

Thanks mate, you just made my day!!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment