create 2 pdf with 2 differnt range

Moose1605

New Member
Joined
Dec 19, 2016
Messages
27
hi,

The code make a pdf from the worksheet and mail it .
but i want to make 2 pdf from that worksheet (i want to select my range for the 2 pdf) and mail it.

rgd

code pdf

Code:
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

Code mail

Code:
Sub sendmail()
'Werkt enkel inj 2007 en hoger
    Dim sh As Worksheet
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileName As String
    'voorlopig locatie voor het opslaan PDF files
    'je kan ook een andere locatie gebruiken vb
    'TempFilePath = Environ$("temp") & "\"
    TempFilePath = Sheets("Gegevens").Range("C2")
    
    'Loop voor elk werkblad
    For Each sh In ThisWorkbook.Worksheets
       FileName = ""
        
        'Test H11 voor email
        If sh.Range("H11").Value Like "?*@?*.?*" Then
            ' Als er mail is in H11 maak dan pdf met naam en datum aan
            TempFileName = TempFilePath & sh.Range("H6") & " " & sh.Name & "  " & sh.Range("D19") & "  " & "  " _
                         & Format(Now, "dd-mmm-yy") & ".pdf"
            FileName = RDB_Create_PDF(Source:=sh, _
                                      FixedFilePathName:=TempFileName, _
                                      OverwriteIfFileExist:=Sheets("Gegevens").Range("C3"), _
                                      OpenPDFAfterPublish:=Sheets("Gegevens").Range("C4"))
            'Als pdf is ok dan mail opmaken
            If FileName <> "" Then
                RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                                     StrTo:=sh.Range("H11").Value, _
                                     StrCC:=Sheets("Gegevens").Range("C5"), _
                                     StrBCC:=Sheets("Gegevens").Range("C6"), _
                                     StrSubject:=Sheets("Gegevens").Range("C7"), _
                                     Signature:=True, _
                                     Send:=Sheets("Gegevens").Range("C9"), _
                                     StrBody:="[B]Beste " & sh.Range("H6") & " " & "," & " [/B]
" & _
                                              "******>Hierbij zenden wij de gevraagde offerte van LPW type:" & " " & sh.Range("D19") & _
                                              "

" & "aqua"
            Else
                MsgBox "Was niet mogelijk om pdf te maken door:" & vbNewLine & _
                       "Microsoft Add-in zijn niet geinstaleerd" & vbNewLine & _
                       "Je hebt de GetSaveAsFilename dialog geannuleerd" & vbNewLine & _
                       "De opgegeven locatie voor het opslaan in arg 2 is niet juist" & vbNewLine & _
                       "U wou het overschrijven van een bestaande naam niet uitvoeren" & vbNewLine & _
                       "Blijft het probleem aan houden neem contact op met kristof@aquapura.be"
            End If
        End If
    Next sh
End Sub
 
Last edited:

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
The following code will export the selected cells as a PDF:

Code:
Sub Macro1()'
' Macro1 Macro
'


'
    Selection.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
        "U:\Outstations\Masters\West & North Yorkshire Master.pdf", Quality:= _
        xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False
End Sub

So basically, you just need a way of capturing the selection then run the above code snippet do you?
 
Upvote 0
How do you plan to physically select the range? Will it be the same range all the time?

What is the user trying to do?
 
Upvote 0

Forum statistics

Threads
1,216,101
Messages
6,128,838
Members
449,471
Latest member
lachbee

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top