+ Reply to Thread
Results 1 to 1 of 1

Macro to print multiple worksheets to multiple PDFs.

Hybrid View

  1. #1
    Registered User
    Join Date
    10-14-2010
    Location
    Sterling, VA, USA
    MS-Off Ver
    Excel 2007
    Posts
    1

    Macro to print multiple worksheets to multiple PDFs.

    Hello to all...any help on this subject is greatly appreciated...

    I have a workbook that has about 25 worksheets. I need a macro that will convert each worksheet into its own separate PDF and saves it based on the worksheet/tab name. So, I would like to run a macro that when ran, will create 25 PDF files in a location of my choice, where each PDF filename is automatically generated in the form of WORKSHEETNAME_DATE.

    I have a current macro that will print one or multiple worksheets into a single PDF, so I feel like I am close...here is the current code that I have...

    Sub RDB_Worksheet_Or_Worksheets_To_PDF()
        Dim FileName As String
    
        If ActiveWindow.SelectedSheets.Count > 1 Then
            MsgBox "There is more then one sheet selected," & vbNewLine & _
                   "be aware that every selected sheet will be published"
        End If
    
        'Call the function with the correct arguments
        'Tip: You can also use Sheets("Sheet3") instead of ActiveSheet in the code(sheet not have to be active then)
        FileName = RDB_Create_PDF(ActiveSheet, "", True, True)
    
        'For a fixed file name and overwrite it each time you run the macro use
        'RDB_Create_PDF(ActiveSheet, "C:\Users\Ryan\Test\YourPdfFile.pdf", True, True)
    
        If FileName <> "" Then
            'Ok, you find the PDF where you saved it
            'You can call the mail macro here if you want
        Else
            MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                   "Microsoft Add-in is not installed" & vbNewLine & _
                   "You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
                   "The path to Save the file in arg 2 is not correct" & vbNewLine & _
                   "You didn't want to overwrite the existing PDF if it exist"
        End If
    End Sub
    That code references a function called RDB_Create_PDF...here is the code for that function...

    Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
                            OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
        Dim FileFormatstr As String
        Dim Fname As Variant
    
        'Test If the Microsoft Add-in is installed
        If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
             & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
    
            If FixedFilePathName = "" Then
                'Open the GetSaveAsFilename dialog to enter a file name for the pdf
                FileFormatstr = "PDF Files (*.pdf), *.pdf"
                Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                                                      Title:="Create PDF")
    
                'If you cancel this dialog Exit the function
                If Fname = False Then Exit Function
            Else
                Fname = FixedFilePathName
            End If
    
            'If OverwriteIfFileExist = False we test if the PDF
            'already exist in the folder and Exit the function if that is True
            If OverwriteIfFileExist = False Then
                If Dir(Fname) <> "" Then Exit Function
            End If
    
            'Now the file name is correct we Publish to PDF
            On Error Resume Next
            Myvar.ExportAsFixedFormat _
                    Type:=xlTypePDF, _
                    FileName:=Fname, _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=OpenPDFAfterPublish
            On Error GoTo 0
    
            'If Publish is Ok the function will return the file name
            If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
        End If
    End Function
    Last edited by ryanwood17; 10-14-2010 at 02:02 PM.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1