Visio multi-layer visibility toggle

visio_toggle.vba

' 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

Thanks mate, you just made my day!!