Layer Visibility Problem 2002

L

lennybonilla

This code will let you toggle the visibility layer called "Details" on
every page of a Visio document. I found no functional code online to
do this in Visio 2002, so I figured I'd post it up.

It gets around a 2002 bug where pages that are not active are not
refreshed properly by setting each page to the active page and then
selecting all.

Sub DetailsToggle()
Dim toggleValue As Integer
Dim layerName As String
Dim vsoLayer1 As Visio.Layer
Dim vsoPage As Visio.Page
Dim UndoScopeID1 As Long
Dim originalActivePage As String

layerName = "Details"



UndoScopeID1 = Application.BeginUndoScope("Layer Properties")


originalActivePage = ActiveWindow.Page
For Each vsoPage In Application.ActiveDocument.Pages
ActiveWindow.Page = vsoPage.Name
For Each vsoLayer1 In vsoPage.Layers

toggleValue = vsoLayer1.CellsC(visLayerVisible)

If toggleValue = 1 Then
toggleValue = 0
Else
toggleValue = 1
End If

If vsoLayer1.Name = layerName Then
vsoLayer1.CellsC(visLayerVisible) = toggleValue
vsoLayer1.CellsC(visLayerPrint) = toggleValue
End If
ActiveWindow.SelectAll
Next vsoLayer1
Set vsoLayer1 = Nothing

Next vsoPage
Set vsoPage = Nothing

ActiveWindow.Page = originalActivePage
Application.EndUndoScope UndoScopeID1, True
End Sub
 
J

JuneTheSecond

Would you please try nect?

Sub DetailsToggle()
Dim toggleValue As Integer
Dim layerName As String
Dim vsoLayer1 As Visio.Layer
Dim vsoPage As Visio.Page
Dim UndoScopeID1 As Long
Dim originalActivePage As String

layerName = "Details"



UndoScopeID1 = Application.BeginUndoScope("Layer Properties")


originalActivePage = ActiveWindow.Page
For Each vsoPage In Application.ActiveDocument.Pages
' ActiveWindow.Page = vsoPage
For Each vsoLayer1 In vsoPage.Layers

toggleValue = vsoLayer1.CellsC(visLayerVisible)

If toggleValue = 1 Then
toggleValue = 0
Else
toggleValue = 1
End If

If vsoLayer1.Name = layerName Then
vsoLayer1.CellsC(visLayerVisible) = toggleValue
vsoLayer1.CellsC(visLayerPrint) = toggleValue
End If
' ActiveWindow.SelectAll
Next vsoLayer1
' Set vsoLayer1 = Nothing

Next vsoPage
' Set vsoPage = Nothing

ActiveWindow.Page = originalActivePage
Application.EndUndoScope UndoScopeID1, True
End Sub
 
Top