将Excel范围粘贴到电子邮件中作为图片

我从Excel（Office 2013）创buildOutlook电子邮件。 我想将一系列单元格（C3：S52）粘贴到电子邮件中作为图片。

以下是我到目前为止的代码。 我哪里错了？

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

这是一个在Office 2010中testing过的工作示例：

 '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 

结果：

在上面的代码中，我使用了早期绑定来访问自动完成; 要使用此代码，您需要设置对Microsoft Outlook和Microsoft Word对象库的引用 ： 工具 > 引用... >设置复选标记，如下所示：

或者，您可以忘记引用并使用晚期绑定，将所有Outlook和Word对象声明As Object而不是As Outlook.Application和As Word.Document等。

---

显然你在执行上述操作时遇到了麻烦。 范围将粘贴为表格而不是电子邮件中的图片。 我没有解释为什么会发生。

另一种方法是将其作为图像粘贴到Excel中，然后将该图像剪切并粘贴到电子邮件中：

 '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 

正如WizzleWuzzle指出的那样 ，也可以使用PasteSpecial而不是PasteAndFormat或Paste …

 wordDoc.Range.PasteSpecial , , , , wdPasteBitmap 

…但由于某种原因，结果图像不能很好地呈现。 看下面的桌子是怎么模糊的：