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.
Background:
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
Next
'verfiy office code
If aCode = "Not" Then
MsgBox "an Office has not bee assigned yet", vbExclamation
Else
'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
Else
'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 = "https://communities.int.ch2m.com/office/" & aCode & "/FloorPlans"
sPath = "https://teams.ch2m.com/office/" & 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?