CODEWITHSUNDEEP
vbaexcelpdf
arbitel
arbitel

Reputation: 321

Changing VBA that creates Multiple PDFs to Single PDF

The code below is working great to create PDFs from Worksheet 3 to the Worksheet named "Post" while ignoring any hidden sheets. It creates an individual PDF for each of these worksheets. This is linked to a shape that users click and are then prompted to select a folder to save all the PDFs.

I'm trying to alter the code below to do the exact same thing EXCEPT create a single PDF with each visible worksheet between sheet 3 and "Post".

I've been massaging the code around for a while and am wondering if anyone knows the best way to accomplish this?

Sub SaveAllPDF()
Dim i As Integer
Dim Fname As String
Dim TabCount As Long

TabCount = Sheets("Post").Index
'Set the TabCount to the last cell you want to PDF

Dim dialog As FileDialog
Dim path As String

Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
dialog.AllowMultiSelect = False
If dialog.Show = -1 Then
    path = dialog.SelectedItems(1)
    ' Begin the loop.
    For i = 3 To TabCount
    'Set i = the number of the first sheet you want to PDF in order from left to right To TabCount
        If Sheets(i).Visible <> xlSheetVisible Then
        Else
            With Sheets(i)
                Fname = .Range("C15") & " " & .Range("E13") & "-" & .Range("B1")
                'The Fname above is equaling the cells that the PDF's filename will be
                'The folder directory below is where the PDF files will be saved
                .ExportAsFixedFormat Type:=xlTypePDF, FileName:=path & "\" & Fname, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            End With
        End If
    Next i

    Call Shell("explorer.exe" & " " & path & "\", vbNormalFocus)
    'This opens the folder where the PDFs are saved
End If
End Sub

Upvotes: 0

Views: 932

Answers (3)

DCX
DCX

Reputation: 117

This works in my file for emailing visible tabs as pdf's your use while different the same applies...you don't need to code for hidden/not hidden with this 

' Export activesheet as PDF
 With ActiveWorkbook
      .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile,  
              Quality:=xlQualityStandard, IncludeDocProperties:=True,     
                     IgnorePrintAreas:=False, OpenAfterPublish:=False
 End With

Upvotes: 1

Parfait
Parfait

Reputation: 107567

Instead of exporting each worksheet inside the loop, export the entire workbook outside the loop with Workbook.ExportAsFixedFormat.

With this method, arguments From and To allow you to select what pages to output. However, you need to know where the visible worksheets page numbers lie. It may not necessarily be per their worksheet number as some worksheets can print into multiple pages. Find page numbers by manually saving entire workbook in PDF.

Alternatively, you can continue with your loop and combine multiple PDFs using the Adobe Acrobat SDK. See AcroExch.AvDoc and AcroExch.PDDoc objects. However, users of your Excel workbook will need to have Adobe Acrobat (not just the free Reader) installed on their machines to reference the Adobe API in VBA.

Upvotes: 0

FreeMan
FreeMan

Reputation: 5687

If you select multiple worksheet tabs with the mouse, then select print, it will print them all as one print job, so give it a try in code:

Sub SaveAllPDF()
Dim i As Integer
Dim Fname As String
Dim TabCount As Long
Dim aSheetnames As Variant

TabCount = Sheets("Post").Index
'Set the TabCount to the last cell you want to PDF

Dim dialog As FileDialog
Dim path As String

Set dialog = Application.FileDialog(msoFileDialogFolderPicker)
dialog.AllowMultiSelect = False
If dialog.Show = -1 Then
    path = dialog.SelectedItems(1)
    ' Begin the loop.
    For i = 3 To TabCount
    'Set i = the number of the first sheet you want to PDF in order from left to right To TabCount
        If Sheets(i).Visible <> xlSheetVisible Then
        Else
            redim preserve aSheetnames(i-2)  'subtract 2, since i starts at 3
            asheetnames(i-2) = sheets(i).name  'build array of the sheets to print
        End If
     Next
     Fname = 'make something up here for your bulk file name
     Sheets(asheetnames).ExportAsFixedFormat Type:=xlTypePDF, FileName:=path & "\" & Fname, Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True

End If
End Sub

NOTE: No guarantees expressed or implied, you may have to do some debugging, as this is off the top of my head, but it just might work...

Upvotes: 1

Related Questions