Export pages from an active document to PDF

Microsoft offers an  add-in to export documents to PDF for Office 2007. If this add-in is used in Visio, it will always export the whole page (as configured in the page setup) to the PDF. If you export a drawing to PNG instead, only the drawing itself is exported, but not the whole page. The macro below solves this problem, by temporarily resizing the page to exactly fit the contents of the drawing, then the figure is exported. Afterwards the resizing is undone.

There is also a file attached to this page which you can download and simply add to your MyFiles/MyShapes/ folder. After you open a Visio drawing, you need to open File/MyShapes/DissMacros (say enable macros, if asked). This will add the macros from DissMacros.vss to your current drawing.

Access to the macros is possible via: Tools/Macro/DissMacros/Module1/...

To export a page choose: ExportActivePage

The document will be exported to VISIO_FILENAME_WITHOUT_SUFFIX/PAGE_NAME.pdf

Sub ExportAllPagesFromActiveDocument()
    ExportAllPages ActiveDocument
End Sub

Sub ExportAllPages(doc As Document)
    For ii = 1 To doc.Pages.Count
        ExportPageFromDocument doc.Pages(ii), doc, doc.path
    Next ii
End Sub

Sub ExportActivePage()
    ExportPageFromDocument ActivePage, ActiveDocument, ActiveDocument.path
End Sub

Sub ResizeActivePage()
    ActivePage.ResizeToFitContents
End Sub

' Stores the page in "targetPath\docName\pagename.xxx" as png, wmf, emf and pdf
Sub ExportPageFromDocument(pg As page, doc As Document, targetPath As String)

    resize = doc.BeginUndoScope("resize")
    
    ' resize page to get correct bounding box
    pg.ResizeToFitContents
        
    'MsgBox "Exporting to: " + GenerateName(targetPath, doc.Name, pg.Name, "[png|wmf|emf|pdf]")
    Dim finalPath As String
    finalPath = CreateDir(targetPath, doc.Name)
    pg.Export GenerateName(finalPath, pg.Name, "png")
    pg.Export GenerateName(finalPath, pg.Name, "wmf")
    pg.Export GenerateName(finalPath, pg.Name, "emf")
    pdfName = GenerateName(finalPath, pg.Name, "pdf")
    
    doc.ExportAsFixedFormat visFixedFormatPDF, pdfName, visDocExIntentPrint, visPrintFromTo, pg.Index, pg.Index
    
    ' This will rollback all changes
    doc.EndUndoScope resize, False
    
End Sub

Function CreateDir(path As String, docName As String)
    Dim finalPath As String
    
    finalPath = path + Replace(docName, ".vsd", "")
    
    If Len(FileSystem.Dir(finalPath, vbDirectory)) = 0 Then
        MkDir finalPath
    End If
    CreateDir = finalPath
End Function

Function GenerateName(path As String, pageName As String, ext As String)
    GenerateName = path + "\" + pageName + "." + ext
End Function
Sub ExportAllFilesInDir(path As String)
    Dim doc As Document
    Dim actDoc As Document
    Dim cFile As String
    Dim cFiles(1000) As String
    
    Set actDoc = ActiveDocument
    
    Pattern = "*.vsd"
    
    ii = 0
    cFile = Dir(path + Pattern)
    Do While cFile <> ""
        cFiles(ii) = cFile
        ii = ii + 1
        cFile = Dir
    Loop
    
    ii = 0
    Do While cFiles(ii) <> ""
        Set doc = Visio.Documents.Open(path + cFiles(ii))
        ExportAllPages doc
        doc.SaveAs path + cFiles(ii) + ".tmp"
        doc.Close
        ii = ii + 1
    Loop
End Sub

Sub ExportAllFilesInActiveDir()
    ExportAllFilesInDir ActiveDocument.path
End Sub