Hi Team,
Struggling on how I can set a rule to PDF 2 pages if some data is in the 2nd page / specific cells. If no data is in the specific cell, then only PDF the 1st Page.
Below is my current code and a screenshot of my Excel. I have a loop which runs from Row 5 to 32, then if there is more data it jumps back in at Row 35 and continues on.. However, the data is a moving target and sometimes may not go past row 32.. hence only wanting to PDF if 2 data spills into 2nd page.
Im leaning towards 2 scenarios
1) If data is in Cells B35 then PDF 2 pages
or
2) If loop goes into range B35 > onwards then PDF 2 pages
Screenshot below
And below code where I believe where the soltution would need to be
Am I going about this the right way?
Any Ideas?
Regards
Joey Wright
Struggling on how I can set a rule to PDF 2 pages if some data is in the 2nd page / specific cells. If no data is in the specific cell, then only PDF the 1st Page.
Below is my current code and a screenshot of my Excel. I have a loop which runs from Row 5 to 32, then if there is more data it jumps back in at Row 35 and continues on.. However, the data is a moving target and sometimes may not go past row 32.. hence only wanting to PDF if 2 data spills into 2nd page.
Im leaning towards 2 scenarios
1) If data is in Cells B35 then PDF 2 pages
or
2) If loop goes into range B35 > onwards then PDF 2 pages
Screenshot below
And below code where I believe where the soltution would need to be
VBA Code:
'Define PDF Filename
Sheets(W_Truck).Select
PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then
PdfFile = Left(PdfFile, i - 1)
End If
'Sheets(W_Truck2).Select
PdfFile = PdfFile & " " & ActiveSheet.Name & " " & Format(Date, "YYYYMMDD") & ".pdf"
' Export activesheet as PDF
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
OutlApp.Visible = True
On Error GoTo 0
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
'.SentOnBehalfOfName = "FCLOPS@mondialefreight.com"
.Subject = "LCL RUNSHEET" & " / " & W_Truck & " " & W_Driver & " " & Today
.To = W_Email_Address ' <-- Put email of the recipient here
.CC = W_CC '<-- Put email of 'copy to' recipient here
.htmlbody = StrLCLMSG & strTableData & strTableEnd
.Attachments.Add PdfFile
' Try to send
On Error Resume Next
'Saves the email into Draft Mailbox
.Save
Application.Visible = True
If Err Then
.Save
'MsgBox "E-mail was not sent", vbExclamation
Else
'MsgBox "E-mail successfully Created", vbInformation
End If
On Error GoTo 0
End With
' Delete PDF file
Kill PdfFile
' Quit Outlook if it was created by this code
If IsCreated Then
OutlApp.Quit
End If
' Release the memory of object variable
Set OutlApp = Nothing
strTableData = ""
Sheets("Raw Data").Select
If Range("Q" & i2).Value = "" Then
Exit For
End If
strTableData = ""
W_CC = ""
End If
Am I going about this the right way?
Any Ideas?
Regards
Joey Wright