VBA to Print drawing area and text area to pdf.

[wapperdude]

The code I provided sends 2 pages to printer or to SaveAs PDF, whichever standard Visio process you will chose.  Other than adding the code, you use Visio as is.  The code is configured for your specific file case.  Ah.  I did change your ruler and page settings so that it conforms to standard of having lower left corner at (0,0).  Otherwise, the selecting rectangle needs change in code as does the placement on the temporary page to have correct selection and pasting.

When you print, it recognizes your original page and also the temporary page which contains your right most text contents.  The default config for printing ought to be fine.

Likewise, when you chose to SaveAs PDF, the resultant  PDF contains the same 2 pages.  See attached as 2-page PDF result from SaveAs.

[Biomedmike]

Hello, The pdf you show is exactly what I am looking for. However – I get an error when I use it.

The line below seems to be the problem.

    Set drpShps = ActiveWindow.Page.Drop(selShps, 3.5, 5.5).  'Location of group cntr placed here.
 Assumes page origin is (0,0).

It also says no shapes detected if I bypass the line.

Here is a link to the actual file.
https://drive.google.com/file/d/1AaaAsv3Jhhs8y_oivE1m5wQ5LKWIYoma/view?usp=sharing 
The code that does not work is shown at the top left of the page in red.

Thanks for any help you can provide.

Mike Kauffman
(I feel so dumb)

[wapperdude]

If the printing works, then so should SaveasPDF.  There is no file functionality difference. 

However – I get an error when I use it.

. The PDF file is an output from Visio.  It is not an executable.  Do I misunderstand your statement?

[Biomedmike]

Hello, I placed the code in my Visio in an attempt to get the pdf output that is shown but I get an error instead of a pdf output. The error appears to be from the line below: (Code stops running at this line).

    Set drpShps = ActiveWindow.Page.Drop(selShps, 3.5, 5.5).  'Location of group cntr placed here.
 Assumes page origin is (0,0).

It also says no shapes detected if I bypass the line.

Below is a link to the actual file. See red text below the button that runs the code.
https://drive.google.com/file/d/1AaaAsv3Jhhs8y_oivE1m5wQ5LKWIYoma/view?usp=sharing

I appreciate your assistance. Mike

[wapperdude]

This code is very specific for your use case.  Remember, I reset the drawing page origin to lower left corner and the ruler zeroes to left edge and bottom edge.

It might be preferrable to place the code in the VBA Window > Modules > Newmacros.

Before running macro, make sure the Printing page is not present.  Delete if exists.  Run macro.  Goto printing page, select the red outline box and delete.  The Visio file is now ready for printing.  You may chose to print, should be 2 pages.  Preview if you so desire.  Or, chose SavetoPDF or as PDF.  Again, 2 pages.  2nd page has your off page text from the right side of your drawing page.  As long as the printing page exists, there is no need to re-run the code.  When done, the only additional task is to delete printing page.

For convenience, here's copy  of the code.

******  EDIT:  12/8/2024   *******
Updated code below.  Deleted an unwanted, unnecessary extra macro.

Code Select Expand

Sub SelectShps2()
'This macro is run from the ActivePage.
'It uses SpatialNeighborhood to find and select shapes in desired region
'It adds a temporary page, "Printing", copies the selected shapes to the
'new page.
'Both the original and new page are suitable for printing and PDF storing.
'
' Manually remove printing page.

    Dim curPg As Page
    Dim addPg As Visio.Page
    Dim selBox As Shape
   
    Dim vsoShapeOnPage As Visio.Shape
    Dim intTolerance As Integer
    Dim vsoReturnedSelection As Visio.Selection
    Dim strSpatialRelation As String
    Dim intSpatialRelation As VisSpatialRelationCodes
   
'    On Error Resume Next
    Set curPg = ActiveDocument.Pages.ItemU("Drawing and Decisions")
    ActiveWindow.DeselectAll
   
' Define region for selection
    Set selBox = ActivePage.DrawRectangle(8.5, 0.25, 15.25, 11)
    selBox.Cells("LineColor").Formula = "2"
    selBox.Cells("LineWeight").Formula = "8 pt"
    selBox.Cells("Geometry1.NoFill").Formula = "TRUE"
   
    'Initialize string
    strSpatialRelation = ""
   
    'Set tolerance argument
    intTolerance = 0.25
   
    'Set Spatial Relation argument
    intSpatialRelation = visSpatialOverlap + visSpatialContain + visSpatialTouching
   
    'Get the set of spatially related shapes
    'that meet the criteria set by the arguments.
    Set vsoReturnedSelection = selBox.SpatialNeighbors(intSpatialRelation, intTolerance, 0)
   
    'Evaluate the results.
    If vsoReturnedSelection.Count = 0 Then
        'No shapes met the criteria set by
        'the arguments of the method.
        MsgBox "No shapes found"
    Else
    'Select shape within defined window area
        For Each vsoSelshp In vsoReturnedSelection
            ActiveWindow.Select vsoSelshp, visSelect
        Next
        ActiveWindow.Selection.Copy
        Set selShps = ActiveWindow.Selection.Group
    End If
   
'Add the temporary page:
    Set addPg = ActiveDocument.Pages.Add
    addPg.Name = "Printing"
    addPg.Background = False
    addPg.Index = 2

    Set drpShps = ActiveWindow.Page.Drop(selShps, 3.5, 5.5)
    ActiveWindow.DeselectAll
    ActiveWindow.Page = curPg
    selBox.Delete       'Remove region defining shape

End Sub


[Biomedmike]

Maybe it is my Visio Version. I am running:
Microsoft® Visio® Plan 2 MSO (Version 2411 Build 16.0.18227.20082) 64-bit

Something is still wrong after everything I have done. I am so close yet so far...

I get a message box that says "No Shapes Found" and the code breaks at this line.

    Set drpShps = ActiveWindow.Page.Drop(selShps, 3.5, 5.5)

My Topology Drawing File

[wapperdude]

Attention.  The code shown in reply #19, had unwanted, extra macro at the beginning of included code.  It has been deleted, and reply #19 is now correct.  My apologies. 

I don't have Plan2, but, in this case I do not believe it to be an issue.  As previously noted via PM and emails, I have sent an edited version of your file. 

[Biomedmike]

It must be me or my system. I still get "No shapes found" and an error at the code line below.

    Set drpShps = ActiveWindow.Page.Drop(selShps, 3.5, 5.5)

I should have picked another line of work.

[wapperdude]

Sorry.  Looks like email on laptop failed.  (3X)  Check PM for link to DropBox

[Biomedmike]

Hello, I am inserting a link to YouTube that shows the program and mentions the VBA content I am trying to complete.

YouTube:  https://youtu.be/t02yaA9xB9M?si=DCFKFjyiPy1ONDf7

A link to the latest Visio "Topology Creator" is included below.
https://www.dropbox.com/scl/fi/ha8tjljz5tm173uiu9aty/Topology-Creator-VisGuy-20241208-R4.vsdm?rlkey=8yfx6ncam4xefna69a5f3tnc3&st=0gbywxlj&dl=0

As a recap, the Document will open to the Drawing and Decision page. That page has QTY-3 Sections. Question on the left. A drawing (in the middle) that is created as the questions are answered/toggled and text that is also a result of questions answered.

I would like to be able to do things when complete.
Have a command button that physically prints the Middle Section of the page (The Drawing) and also prints the right side of the page (the text). I do not want to print the questions. There is a command buttnt hat does this above the questions it works pretty good and is not my issue.

My issue is creating a PDF of 2 pages. The PDF should be the Middle Section (The drawing) on page 1 and the Text to the right of the drawing on Page 2.

I added 3 Command buttons to do this above the questions.

Command Button Called "Save as PDF" runs module4 (Sub DoublePageWidthAndPrint) - It works OK. I need to tweak it a little.

Command Button Called "Save as PDF" runs module SelectShps2. When run I get a message that says "No Shapes Found" and then the code crashes at the line:      Set drpShps = ActiveWindow.Page.Drop(selShps, 3.5, 5.5)

I am unable to get a PDF of 2 pages with the Drawing and the Text to the right of the drawing.

I added the other Sub that was sent to me that asks User to accept or decline a page being added to the array. It starts to ask questions but errors at the line starting with                ActivePage.BackPage = Background-1"

Thank you again for all the help.

MichaelRayKauffman@gmail.com

[Thomas Winkel]

Hi,

the code crashes because selShps is empty.
And it is empty because you set selBox to "NoFill", which prevents SpatialNeighbors to work as expected.
Use transparency instead.
Also, you checked for selection.Count = 0, but you did not exit the sub.

There are some not declared variables.
That's not necessarily a problem. But I always recommend setting 'Option Exlicit' which forces all variables to be declared.

Another tip: Never use "On Error resume next" (unless you know exactly what you're doing).
You will not find the bugs with this option.
Instead, it's better to test for possible problems:

Code Select Expand

If selShps Is Nothing Then Exit Sub
But you can also have several print pages on one Visio page. I think that would be a much simpler approach...

I fixed some of the bugs in Module5, please read my comments.
Also have a look into page and print setup (the dotted line is the page break).
https://drive.google.com/file/d/1cnjDmcuOC1s4SM7cAbj05n2QDD9yo6fy/view?usp=sharing

[wapperdude]

@Thomas: 

And it is empty because you set selBox to "NoFill", which prevents SpatialNeighbors to work as expected

. This worked fine in my test cases, but using transparency ought to be fine.  The reason the selection fails is because ruler and page origins are not (0,0).  Thus selection box is misplaced, and nothing selectable within its boundaries.  The selection box grabs the off page comments, adds a new page, and drops them onto this page, within its boundaries.   This seemed to be the preferred approach.

[wapperdude]

Below is modified code that allows arbitrary page(s) selection for printing.  The 1st part of the code grabs, interactively, the chosen pages and puts them into an array.  The 2nd (last) part uses the array for printing the chosen shapes.  Two methods are provided.  Either works.  Use comments to pick one or the other.  1st method is currently used.  You could use command button to call this sub.

Code Select Expand

Public Sub Select_Print_Pages()
    Dim vPg As Visio.Page
    Dim arrPgs() As Visio.Page
    Dim numPgs As Integer, i As Integer, answer as integer
      
    numPgs = ActiveDocument.Pages.Count         'Find number pages in document
    Debug.Print numPgs
    ReDim arrPgs(numPgs)                        'Set array size to max number potential entries
    i = 1
   
    For Each vPg In ActiveDocument.Pages        'Loop thru all fore and background pages
        If vPg.Background = False Then          'Exclude background pages
            myTitle = "Select this page:  " & vPg
            answer = MsgBox(myTitle, vbYesNo)       'Use MsgBox for interactive response
            If answer = 6 Then
                Set arrPgs(i) = vPg
                Debug.Print "Entry: "; i; arrPgs(i)
                i = i + 1
            End If
        End If
    Next
    ReDim Preserve arrPgs(i - 1)                'Resize to actual contents used, keep existing entries
' ****
' For Printing arbitrarily selected pages
' This uses the Document.Print method which also
' applies to pages.
' ****
    Dim dmyPg As Object
    Dim dmyStr As String
    For i = 1 To UBound(arrPgs)
        Set dmyPg = arrPgs(i)
        dmyStr = dmyPg.Print
'Alternative print method:  comment out the above 2 lines, and uncomment the following 3 lines
'        Set vPg = arrPgs(i)
'        ActiveWindow.Page = vPg
'        ActiveDocument.PrintOut PrintRange:=visPrintCurrentPage   ', PrinterName:="Canon MG6200 series Printer"
    Next
End Sub


[wapperdude]

Couple updates pending...
1) ability to specify arbitrary, non-contiguous pages for PDF publication.  Since the desired pages are already in an array, these can be pushed into a new, temporary Visio doc, which will then be converted to PDF.  I'm not aware of an alternate approach.

2) restructuring the entire code such that main section creates the containing array, then both the printing and SaveasPDF can be separate modules which get called by the main module.

[Biomedmike]

Answer #28 Works perfectly. Thank you for sending.

I understand your #29 reply and appreciate your wisdom.

I am finally ready to distribute this to my team.

Thank you and I hope you enjoy the holidays!

Mike