Exporting multiple sheets to PDF in VBA

[nyconfidential]

Hey all, I am trying to export multiple sheets to one PDF. I'm using code that I've used successfully before, but now I get an 1004 message after a minute or so, stating: "Document not saved. The document may be open, or an error may have been encountered when saving" The code is below (It stalls/Errors out on the "ActiveSheet.ExportAsFixedFormat " method). Anyone know what I might be doing wrong? If I just use the first part of the code to select multiple sheets and then go to "File-> Print to Adobe PDF" it works fine. It also works fine if I only try to select one sheet instead of multiple sheets. Any help would be appreciated, thanks!

Public Sub PrintSheetsToPDF()

Dim wrkSheet As Worksheet

For Each wrkSheet In ThisWorkbook.Sheets
         If wrkSheet.Visible = True Then
            wrkSheet.Select False ' note "False" parameter makes sure previous sheets stay selected
            If wrkSheet.Index > 1 Then
                If Sheets(wrkSheet.Index - 1).Name = "ofac" Then Exit For
            End If
         End If
       
Next wrkSheet

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ActiveWorkbook.Path & "\" & Format(Now, "mmddyyy hhmmss") & ".pdf", _
        OpenAfterPublish:=False, IgnorePrintAreas:=False

End Sub

 

[Momentman]

Is the Workbook you are exporting saved? If it is not, the Activeworkbook.Path would return a blank(no path found) and the code will error out

That's my suspicion. Check that and revert

 

[nyconfidential]

Thanks Momentman - I've tried just using a static path, still no dice. This is producing a PDF that is going to be 30+ pages, is there any chance that the size might be playing a role?

 

[Momentman]

Thanks Momentman - I've tried just using a static path, still no dice. This is producing a PDF that is going to be 30+ pages, is there any chance that the size might be playing a role?

Except your Computer is running out of storage space, i would not think that is the problem Can you try it with just 3 sheets, if it works for3, the code is obviously working, then we may need to dig further

 

[nyconfidential]

It turns out it's related to one specific page. If it's not selected the PDF prints fine, no matter how many other sheets are selected. Worst case I can re-create the sheet, just glad I have it narrowed down. Thanks for your help!!

 

[kweaver]

This wonderful routine is all-inclusive. Try it and modify as needed:

Public Sub Save_Selected_Sheets_As_PDF()
' John Walkenbach
' www.j-walk.com
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet, FinalSheet As Worksheet
Dim cb As CheckBox
Dim numSelectedSheets As Integer
Dim PDFfileName As String

Set FinalSheet = ActiveSheet
' Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If
Application.ScreenUpdating = False

' Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
SheetCount = 0

' Add the checkboxes
TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)

' Skip empty sheets and hidden sheets
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i

' Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 240

' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = Application.Max _(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 230
.Caption = "Select sheets to print"
End With

' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront

' Display the dialog box
CurrentSheet.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
numSelectedSheets = 0
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then

'Add this sheet to group
Worksheets(cb.Caption).Select numSelectedSheets = 0
numSelectedSheets = numSelectedSheets + 1

'Original code
'Worksheets(cb.Caption).Activate
'ActiveSheet.PrintOut
' ActiveSheet.PrintPreview 'for debugging
End If
Next cb

If numSelectedSheets > 0 Then
PDFfileName = ThisWorkbook.Path & "\Sheets.pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfileName, _
Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "Created PDF file " & PDFfileName
End If
End If
Else
MsgBox "All worksheets are empty."
End If

' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete

' Reactivate original sheet
FinalSheet.Activate
End Sub

 

[nyconfidential]

This wonderful routine is all-inclusive. Try it and modify as needed:

Public Sub Save_Selected_Sheets_As_PDF()
' John Walkenbach
' www.j-walk.com
Dim i As Integer
Dim TopPos As Integer
Dim SheetCount As Integer
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet, FinalSheet As Worksheet
Dim cb As CheckBox
Dim numSelectedSheets As Integer
Dim PDFfileName As String

Set FinalSheet = ActiveSheet
' Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If
Application.ScreenUpdating = False

' Add a temporary dialog sheet
Set CurrentSheet = ActiveSheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add
SheetCount = 0

' Add the checkboxes
TopPos = 40
For i = 1 To ActiveWorkbook.Worksheets.Count
Set CurrentSheet = ActiveWorkbook.Worksheets(i)

' Skip empty sheets and hidden sheets
If Application.CountA(CurrentSheet.Cells) <> 0 And _
CurrentSheet.Visible Then
SheetCount = SheetCount + 1
PrintDlg.CheckBoxes.Add 78, TopPos, 150, 16.5
PrintDlg.CheckBoxes(SheetCount).Text = _
CurrentSheet.Name
TopPos = TopPos + 13
End If
Next i

' Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 240

' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = Application.Max _(68, PrintDlg.DialogFrame.Top + TopPos - 34)
.Width = 230
.Caption = "Select sheets to print"
End With

' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront

' Display the dialog box
CurrentSheet.Activate
Application.ScreenUpdating = True
If SheetCount <> 0 Then
If PrintDlg.Show Then
numSelectedSheets = 0
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then

'Add this sheet to group
Worksheets(cb.Caption).Select numSelectedSheets = 0
numSelectedSheets = numSelectedSheets + 1

'Original code
'Worksheets(cb.Caption).Activate
'ActiveSheet.PrintOut
' ActiveSheet.PrintPreview 'for debugging
End If
Next cb

If numSelectedSheets > 0 Then
PDFfileName = ThisWorkbook.Path & "\Sheets.pdf"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFfileName, _
Quality:=xlQualityMinimum, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "Created PDF file " & PDFfileName
End If
End If
Else
MsgBox "All worksheets are empty."
End If

' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete

' Reactivate original sheet
FinalSheet.Activate
End Sub

Thanks kweaver!!