Convert excel print page to pdf and send to email on the print page

Question

I'd like to make a VBA code in excel but I'm stuck. I want it to take my worksheet where I have several pages to print (50 pages in one worksheet).

On every print page there is a sum and if that sum is greater than 0 I want to convert that page to a pdf and send the print page to the email on the page (so it's different emails).

The sum is in F22 and email is in B8 on page 1.

The sum is in F72 and email is in B58 on page 2.

So the range changes by 50 rows every page.

The emails area is B2:F50 on first page and B52:F100 on second page, B102:F150 on the third.

I have tried but can only do it with 1 page and 1 email. here is the code i have, work for 1 page

Sub RDB_Selection_Range_To_PDF_And_Create_Mail()
Dim Charge As Integer
Charge = ThisWorkbook.Sheets("Crosscharge").Cells(23, 6).Value
If Charge > 0 Then
    Dim FileName As String

    If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "ungroup the sheets and try the macro again"
    Else
        'Call the function with the correct arguments
        'For a fixed range use this line
        FileName = RDB_Create_PDF(Source:=Range("B2:F50"), _
                                  FixedFilePathName:="", _
                                  OverwriteIfFileExist:=True, _
                                  OpenPDFAfterPublish:=False)

        If FileName <> "" Then
            RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                                 StrTo:="Email", _
                                 StrCC:="", _
                                 StrBCC:="", _
                                 StrSubject:="Text", _
                                 Signature:=True, _
                                 Send:=False, _
                                 StrBody:="<H3><B>Dear Customer</B></H3><br>" & _
                                          "<body>See the attached PDF file with the." & _
                                          "<br><br>" & "Kind regards</body>"
        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 If

End Sub

Hope you can help

Please post the code you have gotten working for one page and one email so that we can help you modify it to work for multiple ranges. — Emily Alden, Apr 01 '19 at 13:48

score 0 · Accepted Answer · answered Apr 02 '19 at 13:19

What you need to do is implement a loop. The fact that your cells are exactly 50 apart for each page makes this very easy for your code. Another note that I see if that you assign the value in cell F23 to an Integer at the very beginning. Unless you can guarantee that it will always be an integer (for example you're rounding) it might be better to define it as Double Also the Integer type can only hold numbers between ~ - 2 billion and 2 billion. If you might be dealing with numbers larger then that use Long.

I was unable to test this code in it's entirety because you call on some custom functions, but try this. If there are any issues let me know and I will update this code.

Sub RDB_Selection_Range_To_PDF_And_Create_Mail()
Dim Charge As Long
Dim LastRow As Long
Dim FileName As String
Dim i As Long

LastRow = sht.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row

If ActiveWindow.SelectedSheets.Count > 1 Then
        MsgBox "There is more then one sheet selected," & vbNewLine & _
               "ungroup the sheets and try the macro again"
End If

i = 23

Do While i <= LastRow

    Charge = ThisWorkbook.Sheets("Crosscharge").Cells(i, 6).Value
    If Charge > 0 Then
        'Call the function with the correct arguments
        'For a fixed range use this line
        FileName = RDB_Create_PDF(Source:=Range("B2:F" & i + 27), _
                                      FixedFilePathName:="", _
                                      OverwriteIfFileExist:=True, _
                                      OpenPDFAfterPublish:=False)

        If FileName <> "" Then
                RDB_Mail_PDF_Outlook FileNamePDF:=FileName, _
                                     StrTo:="Email", _
                                     StrCC:="", _
                                     StrBCC:="", _
                                     StrSubject:="Text", _
                                     Signature:=True, _
                                     Send:=False, _
                                     StrBody:="<H3><B>Dear Customer</B></H3><br>" & _
                                              "<body>See the attached PDF file with the." & _
                                              "<br><br>" & "Kind regards</body>"
        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 If
i = i + 50
Loop
End Sub

Convert excel print page to pdf and send to email on the print page

1 Answers1