Print to PDF and have the filename be the contents of a cell

[dcunningham]

Hi Everyone,

I'm new to VBA (and coding in general), so I'm hoping that this is fairly simple and I'm just out of my depth. I'm using a VBA code from Robert de Bruin's website to print off a specific worksheet in my workbook as a PDF. I've got it working fine, but would like to make a modification to it. The modification would take the contents of the cell A1 on the worksheet "Vehicle Tire Summary" and make it appear as a suggested file name in the SaveAs dialog box that appears when the code is run. This cell contains the title for the summary report that I have formatted in the worksheet Vehicle Tire Summary, which I have being filled out automatically using VBA based on whatever cell a user clicks on another worksheet called "Maintenance Dashboard". I'm not sure if it matters, but the title sits in a series of merged sells (A1:I2). I have seen other solutions that offer a similar type of functionality to de Bruin's code, but I like that there's a dialogue box because it allows the user to select where they want to save the file because different users of this workbook will want to save the file in different locations.

Here's the code I'm using at the moment, I have a few lines commented at the moment because I don't want the functionality there while I'm working with the Workbook:

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


    '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
        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 Vehicle Tire Summary sheet
    Sheets("Vehicle Tire Summary").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("Vehicle Tire Summary"), _
                              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("Vehicle Tire Summary").Visible = xlSheetVeryHidden


End Sub

Any help anyone can provide would be greatly appreciated. I apologize in advance for any misuse of any terminology.

Regards,

Dan

 

[ranman256]

what about adding this:

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 = 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")

 

[dcunningham]

what about adding this:

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 = 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")

Thank you very much ranman256! It works just like I wanted it to, I just had to make a slight alteration to the second additional line of code that you had:

msTitle = [B][COLOR=#B22222]Sheets("Vehicle Tire Summary").[/COLOR][/B]Range("A1").Value

Thank you again,

Dan