Visio 2010 - VBA? - Automated checkbox creation

Started by rascal84, May 30, 2012, 11:38:35 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

rascal84

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!

nashwaan

#1
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



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.



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.
Give me six hours to chop down a tree and I will spend the first four sharpening the axe — Abraham Lincoln

rascal84

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!


nashwaan

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.
Give me six hours to chop down a tree and I will spend the first four sharpening the axe — Abraham Lincoln

rascal84

#4
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


rascal84

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.


nashwaan

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.



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.
Give me six hours to chop down a tree and I will spend the first four sharpening the axe — Abraham Lincoln

diwakaramit

#8
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?

Paul Herber

Electronic and Electrical engineering, business and software stencils for Visio -

https://www.paulherber.co.uk/