Author Topic: Inconsistent PDF out put  (Read 135 times)

0 Members and 1 Guest are viewing this topic.


  • Full Member
  • ***
  • Posts: 87
Inconsistent PDF out put
« on: April 08, 2020, 09:24:20 AM »
I have made a bit of script to output PDFs from the Visio floor plan I developed.  All has been going well until just recently. 
due to requests from some offices, I have coded in the ability for the floor plan to output multiple pages.  It seems that now, if multiple PDFs is selected, the PDF output gets cropped.  If, with the same file, you select a single PDF file, the output is not cropped.

Here is the code:
    'first need to read the office code from the OfficeTag shape
    'make sure you are on the first page (should be, the button for this is there)
    ActiveWindow.Page = ActiveDocument.Pages(1).Name
    Set bPage = ActiveWindow.Page
    iMax = bPage.Shapes.Count
    'set fail out incase Office Code not found
    aCode = "Not"
    'itterate through shapes to find the one we need
    For i = iMax To 1 Step -1
        Set bShp = bPage.Shapes(i)
        If bShp.Name = "OfficeTag" Then
            aCode = Mid(bShp.CellsU("Prop.MyText").Formula, 2, 3)
            'Debug.Print "acode is : " & aCode
        End If
    'verfiy office code
    If aCode = "Not" Then
        MsgBox "an Office has not bee assigned yet", vbExclamation
        'Customer may want individual pages printed as aposed to 1 file
        'first set the local save to happen.  This should go, once the button is pushed
        filePath = ThisDocument.Path
        checkSave = MsgBox("Would you like individual PDFs per floor?", vbYesNo, "Single/Multiple PDFs?")
        If checkSave = vbYes Then
            'get total number of pages
            aCounter = ActiveDocument.Pages.Count
            'set the dynamic string array length (seems this needs to be done for strings)
            ReDim fileNames(aCounter - 1)
            For i = 1 To aCounter - 1
                'file name structure:  OfficeCode_FLoorPlanYEAR-MOnth-PageNo.PDF
                fileNames(i) = aCode & "_FloorPlan" & Format(Date, "yyyy-mm") & "-" & i & ".PDF"
            Next i
            'if only one file is needed, set array to 1
            ReDim fileNames(1)
            'force it to print only 1 page
            aCounter = 2
            'file name structure:  OfficeCode_FLoorPlanYEAR-MOnth.PDF
            fileNames(1) = aCode & "_FloorPlan" & Format(Date, "yyyy-mm") & ".PDF"
        End If
        'after getting file name(s), print it/them out
        For i = 1 To aCounter - 1
            ActiveDocument.ExportAsFixedFormat visFixedFormatPDF, filePath & fileNames(i), visDocExIntentPrint, visPrintFromTo, i, i '<----------------
        Next i
        'code verified, check if the file also would need to be saved to SharePoint Site
        'this requires a drive mapping, which is currently blocked by Defend Point (Oct 2016)
        ' - old sharepoint sPath = "" & aCode & "/FloorPlans"
        sPath = "" & aCode & "/FloorPlans"
        'message the end user if they wish to export the maps to share point as well
        checkSave = MsgBox("Do you wish to also output a PDF of the Map(s) to : " & sPath & "/" & fileName, vbYesNo, "Output PDF")
        If checkSave = vbYes Then
            'To save to sharepoint, you need to map a drive:
            Set oNetwork = CreateObject("WScript.Network")
            sDrive = "Q:"
            oNetwork.MapNetworkDrive sDrive, sPath
            'use proper file path (drive letter) and file name
            filePath = sDrive & "\"
            For i = 1 To aCounter - 1
                ActiveDocument.ExportAsFixedFormat visFixedFormatPDF, filePath & fileNames(i), visDocExIntentPrint, visPrintAll
            Next i
            'unmap drive when finished
            oNetwork.removenetworkdrive sDrive
        End If
    End If

I use a FOR loop to cycle through the pages, but the line to output the PDF file is the same regardless(marked with a comment arrow above)...  Not too sure why this is happening.  Any ideas?