Hmmm. Perhaps not everyone wants to go thru the Visio file to get the code. So, here are the code modules. NOTE, I declare
globally,
Option Base 1. This makes the arrays start at 1 rather than 0, so, it's not necessary to subtract 1 to properly increment thru an array.
1st Module: to place checkboxes, one for each foreground page, onto a page named TOC:
Sub InsertCkBox()
'Much of this was gleaned from: http://visguy.com/vgforum/index.php?topic=3952.0
'Thanks to Nashwaan for his code development
'
Dim i As Integer
Dim visCkBox As Visio.Shape
Dim pgCnt As Integer
Dim visPg As Visio.Page
Dim pgTOC As Visio.Page
Dim visOle As Visio.OLEObject
Dim pgAry() As Variant
'Initialize variables
pgCnt = 0
Set pgTOC = Nothing
'Find drawing pages, table of contents
For Each visPg In ActiveDocument.Pages
If visPg.Name = "TOC" Then
Set pgTOC = visPg
ActiveWindow.Page = pgTOC
End If
If visPg.Type <> Visio.visTypeBackground And visPg.Name <> "TOC" Then
pgCnt = pgCnt + 1
ReDim Preserve pgAry(pgCnt)
pgAry(pgCnt) = visPg.Name
End If
Next
If pgTOC Is Nothing Then
Debug.Print "No TOC, exiting."
Exit Sub
End If
ActiveWindow.DeselectAll
'Place, configure, initialize the Check Boxes
'
'Probably need test to see if checkbox already exists. Otherwise, may create
'duplicates, or just delete all and re-install. But, for now...
'
For i = 1 To pgCnt
Set visCkBox = pgTOC.InsertObject("{8BD21D40-EC42-11CE-9E0D-00AA006002F3}", visInsertAsControl + visInsertNoDesignModeTransition)
With visCkBox
.CellsU("LocPinX").FormulaU = "Width * 0"
.CellsU("PinX").FormulaU = 6
.CellsU("PinY").FormulaU = 9 - 0.5 * (i - 1)
End With
Set visOle = pgTOC.OLEObjects(visCkBox.Name)
With visOle.Object
.Caption = "Print Pg" & i 'Actual page name could go here.
.TripleState = False 'Allows only checked or unchecked
.Value = True 'Initialize to be printed
.Font.Name = "DomCasual BT"
.Font.Size = 12
.AutoSize = True
.Data1 = pgAry(i) 'Page name here
End With
Next
End Sub
2nd Module: loops thru the checkboxes, gets their status, and prepares a page for printing/not printing by making non-printing pages background. Needs code to do actual printing. Then, after printing is complete, module loops thru and restores the checkboxes and modified pages back to their original state.
It assumes that the active page is the TOC, i.e., the page which contains the checkboxes.Sub WhoToPrint()
'Option here: instead of switching pages to background, could
'make each page active, in turn, and print only the current page.
'This avoids keeping track of background page changes. But, might
'not be suitable in a shared printer environment, as someone might
' "sneak" a print job in the middle printing.
'
' Note, changing page type back and forth can and will change page
' tab order.
'
Dim ChBx As OLEObject
Dim visSkip As Boolean
For Each CkBx In ActivePage.OLEObjects
visSkip = CkBx.Object.Value
If Not visSkip Then 'negative logic!
ActiveDocument.Pages(CkBx.Object.Data1).Background = True
End If
Next
'Print command here.
'Now restore pages to foreground and checkbox to selected
For Each CkBx In ActivePage.OLEObjects
visSkip = CkBx.Object.Value
If Not visSkip Then 'negative logic!
CkBx.Object.Value = True
ActiveDocument.Pages(CkBx.Object.Data1).Background = False
End If
Next
'
End Sub
3rd, optional, sample module: would need one for each checkbox. This merely changes the checkbox background color to make selection more visibly obvious.
Sub CheckBox1_Click()
'This module would be needed for each checkbox. It reacts to CheckBox click event.
'It simply changes background color based upon status of the checkbox.
If CheckBox1.Value = True Then
CheckBox1.BackColor = RGB(255, 255, 0)
Else
CheckBox1.BackColor = RGB(255, 255, 255)
End If
End Sub
Enjoy.
Wapperdude