Consulting

Results 1 to 9 of 9

Thread: vba script to convert worksheets to pdf

  1. #1
    VBAX Tutor
    Joined
    May 2010
    Location
    London
    Posts
    296
    Location

    vba script to convert worksheets to pdf

    Hi All ,

    I need to convert multiple worksheets to the PDF. I've found below script in http://msdn.microsoft.com/en-us/libr...ice.11%29.aspx and tried to modify it for my case. It's not working.

    Sub RDB_Worksheet_Or_Worksheets_To_PDF()
        Dim FileName As String
    
        If ActiveWindow.SelectedSheets.Count > 1 Then
            MsgBox "There is more than one sheet selected," & vbNewLine & _
                   "and every selected sheet will be published."
        End If
    
        'Call the function with the correct arguments.
        'You can also use Sheets("Sheet3") instead of ActiveSheet in the code(the sheet does not need to be active then).
        FileName = RDB_Create_PDF(ActiveSheet, "", True, True)
    
        'For a fixed file name and to overwrite it each time you run the macro, use the following statement.
        'RDB_Create_PDF(ActiveSheet, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)
    
        If FileName <> "" Then
            'Uncomment the following statement if you want to send the PDF by e-mail.
            'RDB_Mail_PDF_Outlook FileName, "ron@debruin.nl", "This is the subject", _
               "See the attached PDF file with the last figures" _
              & vbNewLine & vbNewLine & "Regards Ron de bruin", False
        Else
            MsgBox "It is not possible to create the PDF; possible reasons:" & vbNewLine & _
                   "Add-in is not installed" & vbNewLine & _
                   "You canceled the GetSaveAsFilename dialog" & vbNewLine & _
                   "The path to save the file is not correct" & vbNewLine & _
                   "PDF file exists and you canceled overwriting it."
        End If
    End Sub
    Sub Learning VBA()

    Do
    Practice Most Useful VBA Examples
    Loop Until Become an Expert in VBA

    End Sub

  2. #2
    VBAX Mentor
    Joined
    Jul 2012
    Posts
    398
    Location
    attach please a sample file and explain better your goal and the errors you find

  3. #3
    VBAX Tutor
    Joined
    May 2010
    Location
    London
    Posts
    296
    Location
    Hi Patel ,

    tHANKS for your response.I attached a sample file. I want to convert 2 worksheets called Profile and All to PDF and save them in a specific folder as PDF files. (The rest of the worksheets will be hidden. I am not sure this would stop the code running)

    I am using the VBA script below but error message says "Variable not defined". Hope I made it clear this time

    Cheers
    yeLIZ

    Sub RDB_Worksheet_Or_Worksheets_To_PDF()
        Dim FileName As String
        
        If ActiveWindow.SelectedSheets.Count > 1 Then
            MsgBox "There is more than one sheet selected," & vbNewLine & _
                   "and every selected sheet will be published."
        End If
        
        'Replace numSheets with the number of worksheets that will be saved as PDF
        For x = 2 To numSheets
            Sheets("WorksheetNames").Select
            ThisSheet = ActiveSheet.Range("A" & x).Value
            
            Sheets(ThisSheet).Select
            'Call the function with the correct arguments
            FileName = RDB_Create_PDF(Sheets(ThisSheet), "K:\RS&E\Data booklet for Marian L\PDFs\" & ActiveSheet.Name & ".pdf", True, True)
            
        If FileName <> "" Then
            'Ok, you find the PDF where you saved it
        Else
            MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
                "Microsoft Add-in is not installed" & vbNewLine & _
                "You Cancelled 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
       Next x
    End Sub






    Quote Originally Posted by patel View Post
    attach please a sample file and explain better your goal and the errors you find
    Attached Files Attached Files
    Last edited by Aussiebear; 09-10-2013 at 03:52 PM. Reason: Corrected the tags
    Sub Learning VBA()

    Do
    Practice Most Useful VBA Examples
    Loop Until Become an Expert in VBA

    End Sub

  4. #4
    VBAX Mentor
    Joined
    Jul 2012
    Posts
    398
    Location
    you missed the sub RDB_Create_PDF

  5. #5
    VBAX Tutor
    Joined
    May 2010
    Location
    London
    Posts
    296
    Location
    Hi patel ,

    I didn't write the code so it didn't make sense to me. When you say missing the sub RDB_Create_PDF you mean variable declaration?

    Quote Originally Posted by patel View Post
    you missed the sub RDB_Create_PDF
    Sub Learning VBA()

    Do
    Practice Most Useful VBA Examples
    Loop Until Become an Expert in VBA

    End Sub

  6. #6
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,903
    Location
    No, he means the Sub. This goes in a Module.

    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 to see if the Microsoft Create/Send 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 file.
                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 then test to see if the PDF
            'already exists in the folder and exit the function if it does.
            If OverwriteIfFileExist = False Then
                If Dir(Fname) <> "" Then Exit Function
            End If
    
            'Now export the PDF file.
            On Error Resume Next
            Myvar.ExportAsFixedFormat _
                    Type:=xlTypePDF, _
                    FileName:=Fname, _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=OpenPDFAfterPublish
            On Error GoTo 0
    
            'If the export is successful, return the file name.
            If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
        End If
    End Function

  7. #7
    VBAX Tutor
    Joined
    May 2010
    Location
    London
    Posts
    296
    Location
    Thanks very much for your reply Kenneth Hobs. Just to learn how to run a function procedure, could you please tell me how to use this UDF after it goes in a module? When I go to fX and type =RDB_Create_PDF() what goes into brackets? Sorry if this doesn't sound right?


    I was looking for a Sub procedure as I had to create a macro button for users. Below script has done the job.

    Thanks very much again

    HTML Code:
    Sub ExcelToPDF()
     
      Dim iPtr As Long
      Dim sFileName As String
      
      iPtr = InStrRev(ActiveWorkbook.FullName, ".")
    
      If iPtr = 0 Then
        sFileName = ActiveWorkbook.FullName & ".pdf"
      Else
        sFileName = Left(ActiveWorkbook.FullName, iPtr - 1) & ".pdf"
      End If
    
      sFileName = Application.GetSaveAsFilename(InitialFileName:=sFileName, filefilter:="PDF Files (*.pdf), *.pdf")
    
      If sFileName = "False" Then Exit Sub
     
      ThisWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:=sFileName, Quality:=xlQualityStandard, OpenAfterPublish:=True
     
    End Sub






    Quote Originally Posted by Kenneth Hobs View Post
    No, he means the Sub. This goes in a Module.

    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 to see if the Microsoft Create/Send 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 file.
                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 then test to see if the PDF
            'already exists in the folder and exit the function if it does.
            If OverwriteIfFileExist = False Then
                If Dir(Fname) <> "" Then Exit Function
            End If
    
            'Now export the PDF file.
            On Error Resume Next
            Myvar.ExportAsFixedFormat _
                    Type:=xlTypePDF, _
                    FileName:=Fname, _
                    Quality:=xlQualityStandard, _
                    IncludeDocProperties:=True, _
                    IgnorePrintAreas:=False, _
                    OpenAfterPublish:=OpenPDFAfterPublish
            On Error GoTo 0
    
            'If the export is successful, return the file name.
            If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
        End If
    End Function
    Sub Learning VBA()

    Do
    Practice Most Useful VBA Examples
    Loop Until Become an Expert in VBA

    End Sub

  8. #8
    VBAX Guru Kenneth Hobs's Avatar
    Joined
    Nov 2005
    Location
    Tecumseh, OK
    Posts
    4,903
    Location
    Not all functions can be UDF's. Keep in mind that functions, always return a value, and especially so for UDF's.

    Look at your defined input parameters in a function or sub for that matter, to understand what input is expected. As can see: MyVar, FixedFilePathName, and OverwriteIfFileExist are the input parameters. The return result will be a string.
    Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _      
    OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String

  9. #9
    VBAX Tutor
    Joined
    May 2010
    Location
    London
    Posts
    296
    Location
    Many thanks!Much appreciated

    Quote Originally Posted by Kenneth Hobs View Post
    Not all functions can be UDF's. Keep in mind that functions, always return a value, and especially so for UDF's.

    Look at your defined input parameters in a function or sub for that matter, to understand what input is expected. As can see: MyVar, FixedFilePathName, and OverwriteIfFileExist are the input parameters. The return result will be a string.
    Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _      
    OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Sub Learning VBA()

    Do
    Practice Most Useful VBA Examples
    Loop Until Become an Expert in VBA

    End Sub

Posting Permissions

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