I've been searching this forum and googling like crazy for several days now trying to find what I'm missing...
What I'm attempting to do is write some VBA to automate the creation of multiple checkboxes which will toggle the visibility and print options of each layer on each page of my drawing. I'm more than happy running the code on each page individually as opposed to looping through all the pages automatically.
So, here's the rundown of what I would like my code to accomplish...
for each layer on the page
create checkbox
change checkbox Caption = name of layer (for display purposes)
change checkbox Data1 = name of layer (for code purposes)
change checkbox Name = name of layer (for code purposes)
set checkbox on-click action
I have working code that I can apply to a manually created checkbox and it works as expected to toggle layer visibility and print, but it would be much better if I could automate it.
Here is the code I'm using on the button itself to perform the toggle...
Private Sub CheckBox1_Click()
Dim myLayers As Visio.Layers
Dim myLayerName As Visio.Layer
Dim myLayer As String
Dim myLayerVis As Visio.Cell
Dim myLayerPrint As Visio.Cell
Set myLayers = ActivePage.Layers
For Each myLayerName In myLayers
myLayer = myLayerName.Name
' Debug.Print myLayer
If myLayer = CheckBox1.Caption Then
Set myLayerVis = myLayerName.CellsC(visLayerVisible)
Set myLayerPrint = myLayerName.CellsC(visLayerPrint)
If myLayerVis = 0 Then
myLayerVis.Formula = True
myLayerPrint.Formula = True
ElseIf myLayerVis = 1 Then
myLayerVis.Formula = False
myLayerPrint.Formula = False
End If
End If
Next
End Sub
The way I see it, my loop above is OK and I can reuse the code. The part that I'm having difficulty with is creating the checkbox. I can create a checkbox (at least it LOOKS like a checkbox) using:
Application.ActiveWindow.Page.InsertObject "{8BD21D40-EC42-11CE-9E0D-00AA006002F3}", visInsertAsControl + visInsertNoDesignModeTransition
I have tried using the macro recorder and every method I can think of to insert and edit a checkbox, and even had a little bit of success at it, but ultimately ended up at a brick wall again.
Any information or resources anyone can provide would be much appreciated. I also wouldn't mind if someone wrote the code for me and showed me the error of my ways ;)
I should probably mention that I'm running Visio 2010 standard, and I have Office 2007 installed. I don't have VB Studio or any development specific stuff installed, since by default I'm not a programmer.
I've been trying to avoid going down the userform path, even though that seems to simplify the methods etc that can be used to do all the work I need to do... It just kindof scares me because I understand it even less than standard VBA / CheckBoxes etc etc etc.
Thanks in advance for any replies to this question. I'll gladly supply any information necessary to get this done!
Hi rascal84 and welcome to VisGuy forum.
You can do this via VBA, but it is not straight forward. Before we go throught the solution, i have few comments:
1) When you insert a control, it should have its own event procedure. Lets say you inserted two check boxes in the page, namely: CheckBox1 and CheckBox2. Then there should be CheckBox1_Click() and CheckBox2_Click() event procedures in ThisDocument. One event procedure is not enough. This fact actually imposes a challenge to solve your particular question which is: How to have multiple procedures for the checkboxes that will ultimately control the layers when we don't know ahead how many layers there are?
The only way i can think of to solve this issue is by programmatically add the code for the event procedures. That is, using VBA code to add some VBA code to your module! For an introduction about this, see http://www.cpearson.com/excel/vbe.aspx .
2) When a control is inserted to a page, there are two ways to access it:
- ActivePage.Shapes("CheckBox1") to access the shape properties like .CellsU("Width")
- ActivePage.OLEObjects("CheckBox1") to access the control properties like .Object.Caption or .Object.Data1
3) Your code can be simplified (unnecessary lines are commented):
Private Sub CheckBox1_Click()
'Dim myLayers As Visio.Layers
Dim myLayerName As Visio.Layer
'Dim myLayer As String
'Dim myLayerVis As Visio.Cell
'Dim myLayerPrint As Visio.Cell
On Error Resume Next '* added *'
Set myLayerName = ActivePage.Layers(CheckBox1.Caption) '* modified *'
If myLayerName Is Nothing Then Exit Sub '* added *'
myLayerName.CellsC(visLayerVisible).Formula = CheckBox1.Value '* added *'
myLayerName.CellsC(visLayerPrint).Formula = CheckBox1.Value '* added *'
'For Each myLayerName In myLayers
'myLayer = myLayerName.Name
' Debug.Print myLayer
'If myLayer = CheckBox1.Caption Then
'Set myLayerVis = myLayerName.CellsC(visLayerVisible)
'Set myLayerPrint = myLayerName.CellsC(visLayerPrint)
'If myLayerVis = 0 Then
'myLayerVis.Formula = True
'myLayerPrint.Formula = True
'ElseIf myLayerVis = 1 Then
'myLayerVis.Formula = False
'myLayerPrint.Formula = False
'End If
'End If
'Next
End Sub
Now here is the solution (i hope) to your question:
First, you need to make sure that you have access to ""Trust access to the Visual Basic Project"
To do this: File >> Options >> Trust Center >> Trust Center Settings... >> Macro Settings >> Trust access to the Visual Basic Project
(http://666kb.com/i/c49fr9cip2gy5pqim.jpg)
Second, you need to make sure that you add reference to "Microsoft Visual Basic For Applications Extensibility 5.3"
1. In the Code group on the Developer tab, click Visual Basic.
2. In the Visual Basic Editor, on the Tools menu, click References.
3. In the References dialog box, click Microsoft Visual Basic for Applications Extensibility 5.3, and then click OK.
(http://666kb.com/i/c49gobgvj6k4bstj2.jpg)
After that, copy the below code and run it Test().
Option Explicit
Sub test()
Call AddCheckboxesForLayersInPage(ActivePage)
End Sub
Sub AddCheckboxesForLayersInPage(pag As Visio.Page)
' Abstract: Add checkboxes in a page to toggle layers visibility and printability.
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'// do few checks first
If pag Is Nothing Then Exit Sub
If pag.Type <> Visio.visTypeForeground Then Exit Sub
'// iterate through layer of pag
Dim lyr As Visio.Layer
For Each lyr In pag.Layers
'// iGapBetweenCheckboxes to have a vertical space between checkboxes
Dim iGapBetweenCheckboxes As Integer
iGapBetweenCheckboxes = iGapBetweenCheckboxes + 1
'// insert a checkbox button on the page
Dim shpCheckbox As Visio.Shape
Set shpCheckbox = pag.InsertObject("{8BD21D40-EC42-11CE-9E0D-00AA006002F3}", visInsertAsControl + visInsertNoDesignModeTransition)
'// set Pin position to be left of the checkbox so that checkbox will extend to right when its caption is changed
shpCheckbox.CellsU("LocPinX").FormulaU = "Width*0"
'// set horizontal position of checkbox to be on the right of the page
shpCheckbox.CellsU("PinX").FormulaU = "ThePage!PageWidth-2.5 in"
'// set vertical position of checkbox to be on the right of the page
shpCheckbox.CellsU("PinY").FormulaU = "ThePage!PageHeight-1 in-Height*" & iGapBetweenCheckboxes
'// make the control a little bit wider
shpCheckbox.CellsU("Width").FormulaU = shpCheckbox.CellsU("Width").FormulaU & "*1.3"
'// get access to the OLE ActiveX control object
Dim ole As Visio.OLEObject
Set ole = pag.OLEObjects(shpCheckbox.Name)
'// set caption for the checkbox button
ole.Object.Caption = lyr.Name
'// set Data1 for the checkbox button
ole.Object.Data1 = lyr.Name
'// set *code* name of the checkbox button to the name of layer
ole.Object.Name = Replace(lyr.Name, " ", "") ' as a precaution step, remove space characters
'// set the size for the checkbox button
ole.Object.Font.Size = 12
ole.Object.AutoSize = True
'// initialize the checkbox to 'checked' state
ole.Object.Value = True
'----- make sure "Trust access to the Visual Basic Project" is checked in the Trust Center
'----- make sure reference is added to "Microsoft Visual Basic For Applications Extensibility 5.3"
'// prepare the Click() event handling procedure for the checkbox
Dim strEventDefinitionForCheckbox
strEventDefinitionForCheckbox = _
"" & vbCrLf & _
"Private Sub " & ole.Object.Name & "_Click()" & vbCrLf & _
" Dim lyr as Visio.Layer" & vbCrLf & _
" On Error Resume Next" & vbCrLf & _
" Set lyr = ThisDocument.Pages(""" & pag.Name & """).Layers(""" & lyr.Name & """)" & vbCrLf & _
" If lyr Is Nothing Then Exit Sub" & vbCrLf & _
" lyr.CellsC(Visio.visLayerVisible).FormulaU = " & ole.Object.Name & ".Value" & vbCrLf & _
" lyr.CellsC(Visio.visLayerVisible).FormulaU = " & ole.Object.Name & ".Value" & vbCrLf & _
"End Sub" & vbCrLf
'// get access to the Visual Basic project for the document that contains pag
Dim VBprj As VBIDE.VBProject
Set VBprj = pag.Document.VBProject
'// get access to to the code module of the "ThisDocument"
Dim cod As CodeModule
Set cod = VBprj.VBComponents("ThisDocument").CodeModule
'// delete event procedure for the checkbox if it already exists
Call DeleteExistingProcedure(cod, ole.Object.Name & "_Click")
'// inject the prepared event proedure into ThisDocument module
Call cod.InsertLines(cod.CountOfLines + 1, strEventDefinitionForCheckbox)
Next lyr
End Sub
Sub DeleteExistingProcedure(cod As CodeModule, strProcedureName As String)
' Abstract: Delete a procedure with its body from a component module.
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'// try to find the procedure
On Error Resume Next
Dim nLineProcedureStart As Long
nLineProcedureStart = cod.ProcStartLine(strProcedureName, vbext_pk_Proc)
'// exit if there is no such procedure
If Err.Number <> 0 Then Exit Sub
'// get the kind of procedure
Dim strProcedure As String, ProcedureKind As vbext_ProcKind
strProcedure = cod.ProcOfLine(nLineProcedureStart, ProcedureKind)
'// delete the procedure
Call cod.DeleteLines(nLineProcedureStart, cod.ProcCountLines(strProcedure, ProcedureKind))
End Sub
A working example is attached.
Please ask if this doesn't help. :)
Yousuf.
You good sir are a gentleman and a scholar. The clarification about accessing a control object as an ole object in order to change the caption & data etc was confusing me. I knew I couldn't change it via the regular shape properties, but between ActiveX, OLE, MS Forms 2.0 etc etc I couldn't find a good working example of how to do it.
The only part of this project that isn't working now is renaming the checkbox.
'// set *code* name of the checkbox button to the name of layer
ole.Object.Name = Replace(lyr.Name, " ", "") ' as a precaution step, remove space characters
That is the line that fails. Commenting it out allows things to finish. The error is "Application-defined or object-defined error" run-time error 40044
I also tried to dim a new string variable and set it = Replace(lyr.Name, " ", "") and use the new variable, but I get the same error. I'm assuming that since the Name property of the checkbox is (Name) there's some problem accessing that particular property via name because of the () around it. Basically, ole.Object.Name = isn't so much working
I love that you even went the extra mile with positioning the buttons :) I was planning on doing that manually!
The reason that you get that error is because there is an existing control in the page that already has that name. To test this, delete all checkboxes in the page and re-run the code again. I bet it should work now because there is no naming conflict.
I am working on enhanced version of the code.. but bare with me.
Thanks,
Yousuf.
Much appreciated!
I spent a little time with the code you provided and was able to achieve what I wanted. You are certainly correct about there being some kind of conflict with preexisting control objects. I can't post a copy of my code right now, but I will as soon as I can. It's a little strange, because it works perfectly on one of my pages, but on another page it has problems positioning all of the checkboxes even if I delete all of them from the page and the VBA behind them before I run it. The positioning is easy enough to do manually afterward if I can't find the problem though.
*UPDATE*
All the code I'm using :)
Sub IndexLayers()
Call AddCheckboxesForLayersInPage(ActivePage)
End Sub
Sub AddCheckboxesForLayersInPage(pag As Visio.Page)
' Abstract: Add checkboxes in a page to toggle layers visibility and printability.
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'// do few checks first
If pag Is Nothing Then Exit Sub
If pag.Type <> Visio.visTypeForeground Then Exit Sub
'// iterate through layer of pag
Dim lyr As Visio.layer
For Each lyr In pag.Layers
'// iGapBetweenCheckboxes to have a vertical space between checkboxes
Dim iGapBetweenCheckboxes As Integer
iGapBetweenCheckboxes = iGapBetweenCheckboxes + 1
'// insert a checkbox button on the page
Dim shpCheckbox As Visio.Shape
Set shpCheckbox = pag.InsertObject("{8BD21D40-EC42-11CE-9E0D-00AA006002F3}", visInsertAsControl + visInsertNoDesignModeTransition)
'// set Pin position to be left of the checkbox so that checkbox will extend to right when its caption is changed
shpCheckbox.CellsU("LocPinX").FormulaU = "Width*0"
'// set horizontal position of checkbox to be on the right of the page
shpCheckbox.CellsU("PinX").FormulaU = "ThePage!PageWidth-2.5 in"
'// set vertical position of checkbox to be on the right of the page
shpCheckbox.CellsU("PinY").FormulaU = "ThePage!PageHeight-1 in-Height*" & iGapBetweenCheckboxes
'// make the control a little bit wider
shpCheckbox.CellsU("Width").FormulaU = shpCheckbox.CellsU("Width").FormulaU & "*1.3"
'// get access to the OLE ActiveX control object
Dim ole As Visio.OLEObject
Set ole = pag.OLEObjects(shpCheckbox.Name)
'// set caption for the checkbox button
ole.Object.Caption = lyr.Name
'// set Data1 for the checkbox button
ole.Object.Data1 = lyr.Name
'// set *code* name of the checkbox button to the name of layer
'ole.Object.Name = Replace(lyr.Name, " ", "") ' as a precaution step, remove space characters
Dim layer As String
layer = Replace(lyr.Name, " ", "")
'ole.Object.Name = layer
'// set the size for the checkbox button
ole.Object.Font.Size = 12
ole.Object.AutoSize = True
'// initialize the checkbox to 'checked' state
Dim checked As Integer
Dim vis As Visio.Cell
Set vis = lyr.CellsC(visLayerVisible)
If vis = 1 Then
ole.Object.Value = True
ElseIf vis = 0 Then
ole.Object.Value = False
End If
'----- make sure "Trust access to the Visual Basic Project" is checked in the Trust Center
'----- make sure reference is added to "Microsoft Visual Basic For Applications Extensibility 5.3"
'// prepare the Click() event handling procedure for the checkbox
Dim strEventDefinitionForCheckbox
strEventDefinitionForCheckbox = "Private Sub " & ole.Object.Name & "_Click()" & vbCrLf & _
" Dim lyr as Visio.Layer" & vbCrLf & _
" Dim lyrVis As Visio.Cell " & vbCrLf & _
" Dim lyrPrint As Visio.Cell " & vbCrLf & _
" Set lyr = ActivePage.Layers(" & ole.Object.Name & ".Data1)" & vbCrLf & _
" Set lyrVis = lyr.CellsC(visLayerVisible) " & vbCrLf & _
" Set lyrPrint = lyr.CellsC(visLayerPrint) " & vbCrLf & _
" If lyrVis = 0 Then " & vbCrLf & _
" lyrVis.Formula = True " & vbCrLf & _
" lyrPrint.Formula = True " & vbCrLf & _
" " & ole.Object.Name & ".Value = True " & vbCrLf & _
" ElseIf lyrVis = 1 Then " & vbCrLf & _
" lyrVis.Formula = False " & vbCrLf & _
" lyrPrint.Formula = False " & vbCrLf & _
" " & ole.Object.Name & ".Value = False " & vbCrLf & _
" End If " & vbCrLf & _
" End Sub " & vbCrLf
'" If lyr Is Nothing Then Exit Sub" & vbCrLf & _
'" lyr.CellsC(Visio.visLayerVisible).FormulaU = " & ole.Object.Name & ".Value" & vbCrLf & _
'" lyr.CellsC(Visio.visLayerVisible).FormulaU = " & ole.Object.Name & ".Value" & vbCrLf & _
'"End Sub" & vbCrLf
'// get access to the Visual Basic project for the document that contains pag
Dim VBprj As VBIDE.VBProject
Set VBprj = pag.Document.VBProject
'// get access to to the code module of the "ThisDocument"
Dim cod As CodeModule
Set cod = VBprj.VBComponents("ThisDocument").CodeModule
'// delete event procedure for the checkbox if it already exists
Call DeleteExistingProcedure(cod, ole.Object.Name & "_Click")
'// inject the prepared event proedure into ThisDocument module
Call cod.InsertLines(cod.CountOfLines + 1, strEventDefinitionForCheckbox)
Next lyr
End Sub
Sub DeleteExistingProcedure(cod As CodeModule, strProcedureName As String)
' Abstract: Delete a procedure with its body from a component module.
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'// try to find the procedure
On Error Resume Next
Dim nLineProcedureStart As Long
nLineProcedureStart = cod.ProcStartLine(strProcedureName, vbext_pk_Proc)
'// exit if there is no such procedure
If Err.Number <> 0 Then Exit Sub
'// get the kind of procedure
Dim strProcedure As String, ProcedureKind As vbext_ProcKind
strProcedure = cod.ProcOfLine(nLineProcedureStart, ProcedureKind)
'// delete the procedure
Call cod.DeleteLines(nLineProcedureStart, cod.ProcCountLines(strProcedure, ProcedureKind))
End Sub
Something isn't right here... I've looked through the drawing explorer and I don't see any checkboxes left, but I'm still getting error messages about design mode because of checkboxes. :(
At least I know once I figure out why it's confused I will be able to run the code and get my results.
Thank you again for all your help on this.
Found the solution to my VBA / funky checkbox problem
http://www.tech-archive.net/Archive/Visio/microsoft.public.visio.developer/2005-04/msg00036.html
I checked the linked you provided but i couldn't find anything related to checkboxes problem. Maybe there is another link within that website?
I am glad you got the solution for this problem. But there is an area of improvement here which is an important one:
When a user clicks on the checkbox, the layer visibility changes. However, when the user changes the layer visibility via 'Layer Properties' dialog box, the checkbox on the page doesn't get updated.
(http://666kb.com/i/c4bjuhjmm8gxeewii.png)
To make the checkboxes on the page and the Layer Properites synchronise with each other, we need to intercept the changes happening in the 'Layer Properties'. One way to do this is to listen to Application_CellChanged() event.
I have added the following code in ThisDocument module:
'// appVisio to intercept all changes happening in Visio instance.
Private WithEvents appVisio As Visio.Application
Private Sub Document_RunModeEntered(ByVal doc As IVDocument)
' This event procedure is automatically called when document is opened or when the user
' enters 'Design Mode' and then exists 'Design Mode'. Exiting Design Mode = Run Mode.
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'// establish a connection with the running Visio instance
Set appVisio = ThisDocument.Application
End Sub
Private Sub appVisio_CellChanged(ByVal Cell As IVCell)
' Occurs after the value changes in a cell in a document.
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
Debug.Print "A cell was changed: " & Cell.Name
'// exit if the cell is not related to ThisDocument
If Not Cell.Document Is ThisDocument Then Exit Sub
'// exit if the cell is not related to layer section
If Cell.Section <> Visio.visSectionLayer Then Exit Sub
'// exit if the cell is not related to 'visible' or 'print' properties of a layer
If Cell.Column <> Visio.visLayerVisible _
And Cell.Column <> Visio.visLayerPrint Then Exit Sub
'// exit if the cell is not part of a page (i.e changing layer properties of a master)
If Cell.ContainingPageID = -1 Then Exit Sub
'// get the actual page object which its layer property got changed
Dim pag As Visio.Page
Set pag = Cell.Document.Pages.ItemFromID(Cell.ContainingPageID)
'// synchronise the change in visibility of layer to the printability of
If Cell.Column = Visio.visLayerVisible Then pag.PageSheet.CellsSRC(241, Cell.Row, Visio.visLayerPrint).Formula = Cell.Formula
If Cell.Column = Visio.visLayerPrint Then pag.PageSheet.CellsSRC(241, Cell.Row, Visio.visLayerVisible).Formula = Cell.Formula
'// exit if there is no checkbox controls in the page
If pag.OLEObjects.Count = 0 Then Exit Sub
'// get the name of the layer which its layer property is changed
Dim strLayerName
strLayerName = pag.PageSheet.CellsSRC(Visio.visSectionLayer, Cell.Row, Visio.visLayerName).ResultStr(0)
'// try to get the checkbox that controls the layer visibility and printability
On Error Resume Next
Dim objCheckbox As Object
Set objCheckbox = pag.OLEObjects(Replace(strLayerName, " ", "")).Object
On Error GoTo 0
'// exit if there is no checkbox that controls the layer visibility and printability
If objCheckbox Is Nothing Then Exit Sub
'// synchronise the checkbox to the change in the cell value
objCheckbox.Value = Cell.ResultIU <> 0
End Sub
Also, i made some improvements in the original 'AddCheckboxesForLayersInPage' code:
Sub AddCheckboxesForLayersInPage(pag As Visio.Page)
' Abstract: Add checkboxes in a page to toggle layers visibility and printability.
' ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
'// do few checks first
If pag Is Nothing Then Exit Sub
If pag.Type <> Visio.visTypeForeground Then Exit Sub
'// iterate through layers of pag
Dim lyr As Visio.Layer
For Each lyr In pag.Layers
'// dGapBetweenCheckboxes to have a vertical space between checkboxes
Dim dGapBetweenCheckboxes As Double
dGapBetweenCheckboxes = dGapBetweenCheckboxes + 1.5
'// remove space characters from layer name so it can be used for a shape/OLE name
Dim strObjectName As String
strObjectName = Replace(lyr.Name, " ", "")
'// try to get existing checkbox control for the layer
On Error Resume Next
Dim oleCheckBox As Visio.OLEObject
Set oleCheckBox = Nothing
Set oleCheckBox = pag.OLEObjects(strObjectName)
On Error GoTo 0
'// check we managed to find existing checkbox control for the layer
If Not oleCheckBox Is Nothing Then
'// delete the existing checkbox control for the layer
Call oleCheckBox.Shape.Delete
End If
'// insert a new checkbox button to the page
Dim shpCheckbox As Visio.Shape
Set shpCheckbox = pag.InsertObject("{8BD21D40-EC42-11CE-9E0D-00AA006002F3}", visInsertAsControl + visInsertNoDesignModeTransition)
'// set Pin position to be left of the checkbox so that checkbox will extend to right when its caption is changed
shpCheckbox.CellsU("LocPinX").FormulaU = "Width*0"
'// set horizontal position of checkbox shape to be on the right of the page
shpCheckbox.CellsU("PinX").FormulaU = "ThePage!PageWidth-2.5 in"
'// set vertical position of checkbox shape to be on the top of the page
shpCheckbox.CellsU("PinY").FormulaU = "ThePage!PageHeight-1 in-Height*" & dGapBetweenCheckboxes
'// make the checkbox shape a little bit wider
shpCheckbox.CellsU("Width").FormulaU = shpCheckbox.CellsU("Width").FormulaU & "*1.3"
'// get the actual checkbox control contained by shpCheckbox
Dim objCheckbox As Object
Set objCheckbox = shpCheckbox.Object
'// set name of the checkbox shape and control to be same as layer name (without space chars)
shpCheckbox.Name = strObjectName
objCheckbox.Name = strObjectName
'// set caption for the checkbox button
objCheckbox.Caption = lyr.Name
'// set Data1 for the checkbox button
objCheckbox.Data1 = lyr.Name
'// make the background of the checkbox transparent
objCheckbox.BackStyle = 0
'// initialize the checkbox to same state as layer's visibility
objCheckbox.Value = lyr.CellsC(Visio.visLayerVisible).ResultIU <> 0
'// set the size for the checkbox button
objCheckbox.Font.Size = 12
objCheckbox.AutoSize = True
'----- make sure "Trust access to the Visual Basic Project" is checked in the Trust Center
'----- make sure reference is added to "Microsoft Visual Basic For Applications Extensibility 5.3"
'// prepare the Click() event handling procedure for the checkbox
Dim strEventDefinitionForCheckbox
strEventDefinitionForCheckbox = _
"" & vbCrLf & vbCrLf & vbCrLf & _
"Private Sub " & objCheckbox.Name & "_Click()" & vbCrLf & _
" " & vbCrLf & _
" '// try to get the layer that this checkbox is synchronised with" & vbCrLf & _
" On Error Resume Next" & vbCrLf & _
" Dim lyr as Visio.Layer" & vbCrLf & _
" Set lyr = ActivePage.Layers(" & objCheckbox.Name & ".Caption)" & vbCrLf & _
" " & vbCrLf & _
" '// exit if there is no layer name matches checkbox's name" & vbCrLf & _
" If lyr Is Nothing Then Exit Sub" & vbCrLf & _
" " & vbCrLf & _
" '// synchronise layer's visibility and printability to the state of this checkbox" & vbCrLf & _
" lyr.CellsC(Visio.visLayerVisible).FormulaU = IIf(" & objCheckbox.Name & ".Value, 1, 0)" & vbCrLf & _
" lyr.CellsC(Visio.visLayerPrint).FormulaU = IIf(" & objCheckbox.Name & ".Value, 1, 0)" & vbCrLf & _
" " & vbCrLf & _
"End Sub"
'// get access to the Visual Basic project for the document that contains pag
Dim VBprj As VBIDE.VBProject
Set VBprj = pag.Document.VBProject
'// get access to to the code module of the "ThisDocument"
Dim VBcod As VBIDE.CodeModule
Set VBcod = VBprj.VBComponents("ThisDocument").CodeModule
'// delete event procedure for the checkbox if it already exists
Call DeleteExistingProcedure(VBcod, objCheckbox.Name & "_Click")
'// inject the prepared event proedure into ThisDocument module
Call VBcod.InsertLines(VBcod.CountOfLines + 1, strEventDefinitionForCheckbox)
Next lyr
End Sub
A working example is attached with this post.
Yousuf.
Hi Yousuf- i am working on a similar file, I have a Visio file with multiple pages and multiple layers and sometimes the layers will repeat from one page to another. I am trying to create a cover sheet that will have macro buttons to create check boxes named after the layers. The macro button should have the capability to select all the checkboxes, clear all checkboxes and print pages that have selected layers. Your code does something similar to this but just checking, would you have something that does above steps?
Those posts were from 10 years ago!