Convert excel report to PDF and display in email body

[sxw54533]

I've created a macro that will copy a set range in excel and paste into the body of an email as an image. I'm experiencing issues with the picture resolution when reading on a smart phone device. To improve the resolution I've set the macro to zoom in, copy and paste however this has had little effect on improving the resolution. I've tried to do a simple copy range and paste however the format moves around when pasted into an email.

I would like the report to export to a PDF and appear in the body as a PDF (not as an attachment). This will ensure the resolution remains clear when reading the format does not move around.

The macro will also auto save a copy of the report for future reference.

Can someone please take a look at my code and assist me with my issue?

Thanks

Private Sub EmailShiftReport_Click()
'This macro requires the code from
'to open Outlook

Dim oOutlookApp As Object
Dim oItem As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim xlRng As Range
Set xlRng = Range("$B$1:$V$110") 'The range to be copied
Dim s As String
Dim MyName As String, MyPath As String
MyName = ThisWorkbook.Name
MyPath = ThisWorkbook.Path

If Range("S3").Value = "12pm - 12am (PM Shift)" Then
s = "QLD_EOS_Report_" & Format(Now(), "dd_mmm_yy") & "_PM"
Else
s = "QLD_EOS_Report_" & Format(Now(), "dd_mmm_yy") & "_AM"
End If

ActiveWorkbook.SaveAs Filename:=MyPath & Application.PathSeparator & "Completed Reports" & Application.PathSeparator & s & ".xlsm"

ActiveWindow.Zoom = 400
xlRng.CopyPicture xlScreen, xlBitmap
ActiveWindow.Zoom = 100
Set oOutlookApp = OutlookApp() 
'to open Outlook, or it will not work correctly

'Create a new mailitem
Set oItem = oOutlookApp.createitem(0)
With oItem
.BodyFormat = 2 'html
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor 'access the message body for editing
Set oRng = wdDoc.Range
oRng.collapse 1 'set a range to the start of the message
'oRng.Text = "This is the message body before the Excel range:" & vbCr & vbCr
'Collapse the range to its end
oRng.collapse 0
'oRng.Text = vbCr & "This is the text after the Excel range."
'The range will be followed by the signature associated with the mail account
'collapse the range to its start
oRng.collapse 1
'paste the excel range in the message
oRng.Paste
'Address the message
.To = "email"
'Give it a title
.Subject = s
'attach the workbook
.attachments.Add ActiveWorkbook.FullName
'display the message - this line is required even if you then add the command to send the message
.Display
End With

'Clean up
Set oItem = Nothing
Set oOutlookApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set xlRng = Nothing
lbl_Exit:
Exit Sub
End Sub

 

[Kenneth Hobson]

Have you tried the .htmlBody method using Ron de Bruin's RangeToHTML?

http://www.rondebruin.nl/win/s1/outlook/bmail2.htm

There is an inline way but it is limited to beginning or ending.