Hi,
I need some VBA code that will allow me to print only the pages set as Foreground.
I know Visio normally does this by default, but I have a twist.
Here is the twist. I am using a TOC Table of contents code that I got from this forum, so when I create new pages they will show up on my TOC page. Great stuff.
Now what I would like to do is put a option button or a checkbox next to each entry on the TOC page that will allow me to control what I will be exporting to PDF.
I am assuming the best way to handle this would be that, when the box is checked for that page, the page would go into a "Background" state and therefor would not print. :)
Thanks in advance for your help.
What's the question? ;D
I guess using a VBA dialog with a multi-select list to activate/de-activate the pages would be shorter than implementing a checkbox behaviour in a shape.
Use the macro recorder to get the necessary commands.
Rgds,
Y.
The print dialog is fairly limited. In V2007, there isn't the ability to just print a selection of pages.
But, you could loop thru all the pages, check each for the print this page flag, if true, print the page, if false go to next page. The code would look like this. You need the name of your printer. Obviously, uncomment the if section...it's just an example.
Sub Macro1()
Dim docPages As Visio.Pages
Dim visPg As Visio.Page
Set docPages = Application.ActiveDocument.Pages
For Each visPg In docPages
'If (printable pageflag) then
'set visPg = ActivePage
'Application.ActiveDocument.PrintOut PrintRange:=visPrintCurrentPage, PrinterName:="Canon MG6200 series Printer"
'end if
Next
End Sub
HTH
Wapperdude
"Print current page" is just genious!
What I am hoping to do is, Following the attached code that creates a Table of contents I would like VBA to drop an "Option Button" or a "Check Box" next to the associated rectangles that get created on the TOC page for the pages in the drawing.
Then those checkboxes or option buttons would be checked or unchecked by the user to set the pages to Foreground or Background.
Then I would apply other code after that to export to PPT or just print to PDF.
Is this a possibility, I feel like it can work, I just cant wrap my head around how to get it to work.
PS. I got the TOC Code from this Forum, Great stuff, I use it in all my Visio drawings. :)
Thanks for any help you can offer.
FlowerGirl.
Sub TblOfCont()
' -----------------------------------------------------------------
' Creates stacked page references on a page named TOC in your drawing
' Double-click the "button" label to go to that page
'
' REMEMBER: Set the theme to NO THEME (first option) on Design Menu
' -----------------------------------------------------------------
'This variation of code allows me to create a TOC (Table of Contents) at any time.
'Pages that you delete will be removed from the TOC while leaving decorations alone
'The TOC page was set to background so that it will not show up when the file is saved as a .PDF or .PPt
'Also the code looks for the page named TOC instead of just looking for the first page in your report.
'I run this code from a button on a page named Update. see the last line of code before "Clean Up Environment".
'You may need to tick this out or change it to what you have in your drawing.
Dim PageObj As Visio.Page ' sheet
Dim TOCEntry As Visio.Shape ' shape containing sheet name
Dim CellObj As Visio.Cell ' jump point
Dim PosY As Double ' starting point on the vertical axis
Dim pageCount As Double ' number of pages
Dim loopCount As Integer ' times going through For Each statement
Dim shp As Shape
Dim userRow As Integer
' ActiveDocument.Pages.Count will give the number of pages
' Notice: We're only interested in the number of foreground pages
For Each PageObj In ActiveDocument.Pages ' count the number of sheets
If PageObj.Background = False Then pageCount = pageCount + 1
Next
ActiveWindow.Page = ActiveDocument.Pages("TOC") 'ActiveDocument.Pages(1)
For Each shp In ActivePage.Shapes
If shp.CellExistsU("User.type", False) Then
If shp.Cells("user.type").ResultStr("") = "TOCEntry" Then
shp.Delete
End If
End If
Next shp
' Set variables
loopCount = 1
For Each PageObj In ActiveDocument.Pages
If loopCount > 0 Then
If PageObj.Background = False Then ' Only foreground pages
' PosY = startPoint - (pass x (height + gap)) <-- Chose the vertical starting point on the page
PosY = 9 - (PageObj.Index * 0.25)
''''Set TOCEntry = ActiveDocument.Pages(1).DrawRectangle(4.6, PosY, 4, PosY + 0.5)'this puts it on the first page of your file...yuk
Set TOCEntry = ActiveDocument.Pages("TOC").DrawRectangle(4.1, PosY, 3, PosY + 0.5) 'this puts it on the page I want (TOC)
'Application.ActiveWindow.Page.InsertObject "{8BD21D40-EC42-11CE-9E0D-00AA006002F3}", visInsertAsControl + visInsertNoDesignModeTransition
' Write the page name in the rectangle.
TOCEntry.Text = PageObj.Name
TOCEntry.Cells("VerticalAlign").Formula = "1" 'middle align
TOCEntry.Cells("Para.HorzAlign").Formula = visHorzLeft 'make text box left aligned
TOCEntry.Cells("Width").Formula = "3 in"
TOCEntry.Cells("Height").Formula = "0.26 in"
TOCEntry.Cells("Char.Size").Formula = "14 pt."
userRow = TOCEntry.AddRow(visSectionUser, visRowLast, visTagDefault)
TOCEntry.Section(visSectionUser).Row(userRow).NameU = "Type"
'TOCEntry.Section(shp.Name).Row(userRow) = NameU
TOCEntry.Cells("user.Type").FormulaU = Chr(34) & "TOCEntry" & Chr(34)
'shp.Name = NameU
' Alternate the foreground color
If (loopCount Mod 2 = 0) Then
TOCEntry.Cells("FillForegnd").FormulaU = "RGB(195, 215, 232)"
Else
TOCEntry.Cells("FillForegnd").FormulaU = "RGB(224, 230, 205)"
End If
' Add a link to the sheets
Set CellObj = TOCEntry.CellsSRC(visSectionObject, visRowEvent, visEvtCellDblClick)
CellObj.Formula = "GOTOPAGE(""" + PageObj.Name + """)"
End If
End If
loopCount = loopCount + 1 ' increment the loop counter
Next
ActiveWindow.Page = ActiveDocument.Pages.ItemU("Update") 'Returns to Update Page.
' Clean Up Environment
Set CellObj = Nothing
Set TOCEntry = Nothing
Set PageObj = Nothing
End Sub
any help ??? :'(
Difficult task, considering your previous requirements.
I would suggest a VBA form that:
- gets the users preferences and stores it in an appropriate data structure - on document or on page level. It could even be implemented on the TOC page itself, but this seems to me to be more complicated
- gets rid of any control elements on a TOC page
- sets the pages to print on foreground and those not to print on backward level. Once printing completed, the previously named data structure to be reset to the initial state.
I apologize for not being motivated enough to develop the solution for you, but do hope nevertheless, that you'll find the courage to do it by yourself.
Regards,
Y.
Yeah. This is a lot of work. Here's a partial solution, see attached.
Open the VBA window and there are three code modules.
Under Modules>NewMacros is code to add check boxes. The placement of these boxes is controlled by the last For/Next loop. S/B adaptable to your TOC code.
Under Visio Objects>ThisDocument I show 2 modules. The 1st would be typical of every CkBox. Yes. Every CkBox would need one of these. I'm sure that these could be created programmatically. The Caption would need to be incremented to match the page name...if desired. For the 1st CkBox, the code changes the box to yellow if selected, white if not. Adds visual confirmation.
The 2nd macro is the "printing" macro. It would interrogate the CkBoxes, and print the matching page. There really is no need to switch pages to background unless you want to do a single command batch print. Guess it depends upon the environment. Either way, this macro is where that would be done.
Hope this helps to move forward.
Wapperdude
Cleaned up the file a little. All code centrally located to one area. Code has some additional features. There is more that needs doing, but, this should provide a good framework for remaining development.
This post provided valuable coding insight: http://visguy.com/vgforum/index.php?topic=3952.0 (http://visguy.com/vgforum/index.php?topic=3952.0) Thanks to Nashwaan for his hard effort. I gleaned just a portion of what was done and utilized for code development.
Wapperdude
The code will now loop thru the TOC page and fetch printable pages. After printing, it restores the checkboxes and pages to foreground.
This should be suitable for hand-off and integration with rest of your code.
Wapperdude
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
8) You're really getting into it.
Thanks sooooo much for your help with this problem.
Yacine, you are right, I was working on a type of solution. I was trying to alter the logic in the "HiddingPages" code I got from this site thanks to John Goldsmith's visLog. His code involves a separate form that contains all the pages within your document. He has a checkbox that when checked will "Hide" a page. I was attempting to change that code to set the page to background when checked and back to foreground when unchecked. Not successful yet.
I am going to give Wapperdudes code a whirl.
I will get back to you soon with my results.
Thanks again. :-*
FlowerGirl
I got this code to work and everything is great, but...
You mentioned deleting the duplicate checkboxes prior to creating new ones.
It looks like I need to do that but I am having trouble getting that to work.
This should be the final piece to the puzzle.
Thanks for all your help.
FlowerGirl
One way is to find existing shape, delete it, then, re-insert it using current parameters. Another way would be to find existing shape, keep it, but skip the adding it in, assumes existing parameters are correct.
For the first case, modify the InsertCkBox() macro as follows:
Existing code:
'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
Modified code: insert the following lines between the "For" statement and the "Set visCkBox" statement. The added lines will delete checkbox if it exists, if not, continues on and adds new checkbox.
Dim tmpShp As String
tmpShp = "CheckBox" & i
On Error Resume Next
ActivePage.Shapes(tmpShp).Delete
wapperdude
That did the trick
Thanks so much for your attention to this project.
I also want to thank all the other people on this special Visio site for being so helpful and patient with us newbies.
When I get a chance I will post an example .vsd to show the working model.
FlowerGirl :-*