PDA

View Full Version : [SOLVED] Show Column Headings in PDF's to Be Emailed



BigDawg15
04-17-2017, 08:39 AM
In the attached workbook, I have modified several macros that create worksheets and save them along with a copy as a pdf to the folder in the adjacent directory path.
This all works fine. The problem I can't figure out is how to print the column headings along with worksheet data in the pdf that is saved when I run the emailpm macro.
This macro was obtained from a website (can't remember which one) and slightly modified for my use. It works fine with the exception of the headings not being included.

Any help would be appreciated.

Thank you in advance,

BigDawg15


Code in case anyone doesn't want to download workbook:


Sub emailpm()

SortSubAreas

Dim OutApp, OutMail As Object
Dim SubArea, DSplit As Variant
Dim eAddress, FName As String
Dim FirstRow, LastRow, EMR As Integer
Dim rng As Range

'Change the worksheet and range for the worksheet containing email addresses
SubArea = Worksheets("email").Range("a1:a4")

Set OutApp = Outlook.Application

'Set the first and last row to the first row of your data
FirstRow = 2
LastRow = 2

'Split your data out as the filename cannot have / in it.
'DSplit = Split(Date - 1, "/")
DSplit = Split(Date, "/")

With ActiveWorkbook.Worksheets(1)

For Each i In SubArea
FirstRow = LastRow 'reset the first row of data to where the last ended.
'loop through matching cells to find the last row of this specific department
Do Until .Cells.Range("C" & LastRow).Value <> i
LastRow = LastRow + 1
Loop
'set range of department with headers
Set rng = Range("A1:H1,A" & FirstRow & ":H" & LastRow - 1)
'set the pdf file name
FName = "C:\Users\A10006\Desktop\Docs\SubArea_" & i & " (" & DSplit(2) & "-" & DSplit(0) & "-" & DSplit(1) & ").pdf"
'save pdf. this needs a different range as it does not need the headers listed separately
Range("A" & FirstRow & ":H" & LastRow - 1).ExportAsFixedFormat xlTypePDF, fileName:=FName
'create the email
Set OutMail = OutApp.CreateItem(0)
With OutMail
EMR = 1 'row where the emails address start.
'loop through email worksheet to find correct department
Do Until ActiveWorkbook.Worksheets(3).Cells.Range("a" & EMR).Value = i
EMR = EMR + 1
Loop
'grab email address
eAddress = ActiveWorkbook.Worksheets(3).Cells.Range("b" & EMR).Value
.To = eAddress
'i set the subject to the pdf file name but you can easily change this to the excel workbook name
.Subject = "SubArea_" & i & " (" & DSplit(2) & "-" & DSplit(0) & "-" & DSplit(1) & ")"
'add pdf
.Body = "Attached is your weekly data report." & vbCrLf & vbCrLf & _
"Thank you," & vbCrLf & "Mike"
.Attachments.Add FName
.Display
End With
Next
End With

Set OutMail = Nothing
Set OutApp = Nothing

SortDateOrder

End Sub

mdmackillop
04-17-2017, 10:05 AM
In Sheet1 PageLayout/PrintTitles set "Rows to Repeat at Top" to Row 1

BigDawg15
04-17-2017, 11:25 AM
Worked perfect. Guess I got too tunnel visioned (don't think that is really a word) and missed the obvious.

Thank you so much mdmackillop.

BigDawg15