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