I wrote code to create a PDF file containing one to many sheets based on user selections. The code reads a setup sheet to set the orientation and fit to page settings for each sheet. The code also has to run on a PC and a Mac.
The issue I am experiencing is that after creating a PDF the performance of other code in workbook degrades considerably. For example, code to hide rows in a sheet that normally completes instantaneously takes over 30 seconds after creating a PDF. This happens on PCs and on Macs. Closing and reopening the file corrects the problem, but as soon as I create a PDF it returns. To further analyze the issue I commented out select sections of code, but the only time the issue did not occur is when I commented out all cope related to page orientation and fit to page and all code related to the variant variables - in effect, gutting all important code.
Below is the main procedure, which prepares the sheets, and the procedure that creates the PDF on a PC. Any ideas are greatly appreciated.
The issue I am experiencing is that after creating a PDF the performance of other code in workbook degrades considerably. For example, code to hide rows in a sheet that normally completes instantaneously takes over 30 seconds after creating a PDF. This happens on PCs and on Macs. Closing and reopening the file corrects the problem, but as soon as I create a PDF it returns. To further analyze the issue I commented out select sections of code, but the only time the issue did not occur is when I commented out all cope related to page orientation and fit to page and all code related to the variant variables - in effect, gutting all important code.
Below is the main procedure, which prepares the sheets, and the procedure that creates the PDF on a PC. Any ideas are greatly appreciated.
VBA Code:
Sub CreatePDFs()
Dim C As Integer
Dim FirstOrientation As Integer
Dim sPDFSheets As String
Dim FileName As String
Dim bFirstPage As Boolean
Dim bManual As Boolean
Dim PDFSheets As Variant
Dim PDF As Range
Dim Setup As Range
Set PDF = Range("CreatePDFSheetStart")
Set Setup = shtPrintSetup.Range("PrintSetupSheetStart")
bManual = (Application.Calculation = xlManual)
Application.ScreenUpdating = False
Application.Calculation = xlManual
bFirstPage = False
shtEnd.Visible = True
C = 1
Do Until PDF.Offset(C, 0) = ""
If UCase(PDF.Offset(C, cCreatePDFPrint)) = "X" Then
Worksheets(CStr(PDF.Offset(C, cCreatePDFSheet))).Activate
Select Case Setup.Offset(C, cPrintSetupDefaultOrientation)
Case Is = "Portrait"
With ActiveSheet.PageSetup
.Orientation = xlPortrait
If Setup.Offset(C, cPrintSetupPortraitFitWidth) = "" Then
.FitToPagesWide = False
Else
.FitToPagesWide = CInt(Setup.Offset(C, cPrintSetupPortraitFitWidth))
End If
If Setup.Offset(C, cPrintSetupPortraitFitLength) = "" Then
.FitToPagesTall = False
Else
.FitToPagesTall = CInt(Setup.Offset(C, cPrintSetupPortraitFitLength))
End If
End With
Case Is = "Landscape"
With ActiveSheet.PageSetup
.Orientation = xlLandscape
If Setup.Offset(C, cPrintSetupLandscapeFitWidth) = "" Then
.FitToPagesWide = False
Else
.FitToPagesWide = CInt(Setup.Offset(C, cPrintSetupLandscapeFitWidth))
End If
If Setup.Offset(C, cPrintSetupLandscapeFitLength) = "" Then
.FitToPagesTall = False
Else
.FitToPagesTall = CInt(Setup.Offset(C, cPrintSetupLandscapeFitLength))
End If
End With
End Select
sPDFSheets = sPDFSheets & "|" & ActiveSheet.Name
If Not bFirstPage Then
FirstOrientation = ActiveSheet.PageSetup.Orientation
bFirstPage = True
End If
End If
C = C + 1
Loop
shtEnd.PageSetup.Orientation = FirstOrientation
sPDFSheets = sPDFSheets & "|" & shtEnd.Name
'Set file name
If Range("CalcPDFDate") = Date Then
Range("CalcLastPDFNumber") = Range("CalcLastPDFNumber") + 1
Else
Range("CalcPDFDate") = Date
Range("CalcLastPDFNumber") = 1
End If
FileName = ThisWorkbook.Name & " " & Format(Range("CalcPDFDate"), "mmddyyyy") & "-" & Range("CalcLastPDFNumber")
If sPDFSheets <> "" Then
PDFSheets = Split(Mid(sPDFSheets, 2), "|")
Select Case Range("CreatePDFMacPC")
Case Is = "Mac"
SavePDFMac FileName, PDFSheets, True
Case Is = "PC"
SavePDFPC FileName, PDFSheets, True
End Select
Else
MsgBox "There are no sheets to convert to PDF", vbOKOnly, "Create PDF"
End If
CleanUp:
Set PDF = Nothing
Set Setup = Nothing
PDFSheets = Empty
shtEnd.Visible = False
shtCreatePDF.Activate
If Not bManual Then Application.Calculation = xlAutomatic
End Sub
Sub SavePDFPC(FileName As String, PDFSheets As Variant, Show As Boolean)
Dim C As Integer
Dim sSelected As String
Dim Selected As Variant
Dim ws As Worksheet
'Test if the Microsoft Add-in is installed
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") = "" Then
MsgBox "PDF Add-In has not been installed", vbCritical, "Create PDF"
Exit Sub
End If
On Error Resume Next
Sheets(PDFSheets).Select
'Deselect End sheet
C = 1
For Each ws In ActiveWindow.SelectedSheets
If C <> ActiveWindow.SelectedSheets.Count Then
sSelected = sSelected & "|" & ws.Name
End If
C = C + 1
Next ws
Selected = Split(Mid(sSelected, 2), "|")
Sheets(Selected).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=FileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=Show
On Error GoTo 0
Selected = Empty
PDFSheets = Empty
End Sub
