Insert Excel range into email as image

Question

I am creating an Outlook email from Excel (Office 2013). I want to insert a range of cells (C3: S52) into an email as an image.

Below is the code that I have. Where am I mistaken?

Sub Button193_Click() ' ' Button193_Click Macro ' ' ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("C3:S52").Select Selection.Copy End Sub Sub CreateMail() Dim objOutlook As Object Dim objMail As Object Dim rngTo As Range Dim rngSubject As Range Dim rngBody As Range Dim rngAttach As Range Set objOutlook = CreateObject("Outlook.Application") Set objMail = objOutlook.CreateItem(0) With ActiveSheet Set rngTo = .Range("E55") Set rngSubject = .Range("E56") Set rngBody = .Range("E57") End With With objMail .To = rngTo.Value .Subject = rngSubject.Value .Body = rngBody.Value .Display 'Instead of .Display, you can use .Send to send the email _ or .Save to save a copy in the drafts folder End With Set objOutlook = Nothing Set objMail = Nothing Set rngTo = Nothing Set rngSubject = Nothing Set rngBody = Nothing Set rngAttach = Nothing End Sub Sub Button235_Click() ' ' Button235_Click Macro ' ' ActiveWindow.ScrollColumn = 2 ActiveWindow.ScrollColumn = 1 Range("A1:M27").Select Selection.Copy End Sub Sub RunThemAll() Application.Run "Button193_Click" Application.Run "CreateMail" End Sub 

Answer 1

Here is an example tested in Office 2010:

 'Copy range of interest Dim r As Range Set r = Range("B2:D5") r.Copy 'Open a new mail item Dim outlookApp As Outlook.Application Set outlookApp = CreateObject("Outlook.Application") Dim outMail As Outlook.MailItem Set outMail = outlookApp.CreateItem(olMailItem) 'Get its Word editor outMail.Display Dim wordDoc As Word.Document Set wordDoc = outMail.GetInspector.WordEditor 'To paste as picture wordDoc.Range.PasteAndFormat wdChartPicture 'To paste as a table 'wordDoc.Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False 

Result:

In the above code, I used early binding to have access to autocomplete; To use this code, you need to install links to the Microsoft Outlook and Microsoft Word object libraries: Tools > References ... > check the boxes as:

Alternatively, you can forget about links and use late binding by declaring all Outlook and Word objects As Object instead of As Outlook.Application and As Word.Document , etc.

---

Apparently, you are having trouble implementing the above; the paste range is like a table, not the image in your email message. I have no explanation why this will happen.

An alternative is to paste as an image in Excel, and then cut and paste this image into your email address:

 'Copy range of interest Dim r As Range Set r = Range("B2:D5") r.Copy 'Paste as picture in sheet and cut immediately Dim p As Picture Set p = ActiveSheet.Pictures.Paste p.Cut 'Open a new mail item Dim outlookApp As Outlook.Application Set outlookApp = CreateObject("Outlook.Application") Dim outMail As Outlook.MailItem Set outMail = outlookApp.CreateItem(olMailItem) 'Get its Word editor outMail.Display Dim wordDoc As Word.Document Set wordDoc = outMail.GetInspector.WordEditor 'Paste picture wordDoc.Range.Paste 

As pointed out by WizzleWuzzle , it is possible to use PasteSpecial instead of PasteAndFormat or Paste ...

 wordDoc.Range.PasteSpecial , , , , wdPasteBitmap 

... but for some reason, the resulting image is also not displayed. See how the bottom table looks blurry: