Modifying create PDF code to omit empty pages.

[dcunningham]

Hello Everyone,

I have been using the following code for a number of projects for a while now and it works very well for my purposes:

Option Explicit


'The code below is used by the macros in the other two modules
'Do not change the code in the functions in this module


Function RDB_Create_PDF(Source As Object, FixedFilePathName As String, _
                        OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant
    Dim msTitle As String
    
    msTitle = Sheets("Summary Print").Range("A1").Value
    
    '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(msTitle, 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
        Source.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

Sub RDB_Worksheet_Or_Worksheets_To_PDF()
    Dim FileName As String
    
    'Remove comment formating on line immediately below this one and the one immediately above End Sub to hide Summary Print sheet
    Sheets("Summary Print").Visible = xlSheetVisible
    
    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("YourSheetName") instead of ActiveSheet in the code(sheet not have to be active then)
    FileName = RDB_Create_PDF(Source:=Sheets("Summary Print"), _
                              FixedFilePathName:="", _
                              OverwriteIfFileExist:=True, _
                              OpenPDFAfterPublish:=True)


    'For a fixed file name use this in the FixedFilePathName argument
    'FixedFilePathName:="C:\Users\Ron\Test\YourPdfFile.pdf"


    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
    
    'Sheets("Summary Print").Visible = xlSheetVeryHidden


End Sub

It's a modified version of the code I found on Robert De Bruin's website, here.It works really well for printing to PDF like I want it to, but I've hit a bit of a snag with my current project. When I run the code it does what it's supposed to, it prints off the Summary Print sheet in PDF just like I want it to. The issue is that it prints off the first page which actually has content on it, and then about 200 empty pages after it.

The Summary Print sheet has a series of IF functions that scans through a long list of values (up to 8650 rows) on another sheet that returns the value of the cell if it contains a value that is greater zero. Here's what one of the functions looks like:

=IF('Technican Report Summary'!G6 = 0, "",'Technican Report Summary'!G6)

These functions are copied down from row 9 down to row 8659, which I believe is what's causing the issue of the empty pages when printing. Is there a way to modify my code above to only print up to the rows that contain values and omit those that are empty (that is, those rows that the IF function places "" into)? Or should I change how I'm populating the fields in my Summary Print sheet?

Any help you can provide would be greatly appreciated.

Regards,

Dan