Skip to content

Instantly share code, notes, and snippets.

@Kline-

Kline-/visio_toggle.vba

Last active October 11, 2022 15:18
Show Gist options

  • Select an option

    Learn more about clone URLs
  • Save Kline-/cdde62c2c1ca1a38acf7179bca24c5fe to your computer and use it in GitHub Desktop.

Select an option

Learn more about clone URLs
Save Kline-/cdde62c2c1ca1a38acf7179bca24c5fe to your computer and use it in GitHub Desktop.
Download ZIP

Revisions

  1. Kline- renamed this gist Apr 7, 2020. 1 changed file with 0 additions and 0 deletions.
    0 gistfile1.txt → visio_toggle.vba
    View file
    File renamed without changes.
  2. Kline- created this gist Apr 7, 2020.
    58 changes: 58 additions & 0 deletions gistfile1.txt
    View file
    Original file line number Diff line number Diff line change
    @@ -0,0 +1,58 @@
    ' 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