将多个 Excel 工作表中的内容粘贴到 Outlook 正文中答案

【问题标题】：Paste contents from multiple Excel sheets into Outlook body将多个 Excel 工作表中的内容粘贴到 Outlook 正文中
【发布时间】：2016-02-28 07:59:57
【问题描述】：

我需要将两张纸的内容复制到 Outlook 邮件正文中。

工作表 1 仅包含带有一些合并单元格的文本。
Sheet2 包含图表。

我失败的方法：

将 sheet1 和 sheet2 中的内容复制到临时表中，然后然后将完整内容从临时表复制到邮件正文。
这种方法会弄乱一次完全对齐内容被粘贴到 Outlook 邮件正文中，即使它在临时表中看起来不错。

下面是我使用的代码sn-p。

Sub copy_graph()
Dim outlookapp, outmail, worddoc As Object

Set outlookapp = CreateObject("outlook.application")
Set outmail = outlookapp.createitem(olmailitem)

outmail.display
Set worddoc = outmail.getinspector.wordeditor

ThisWorkbook.Sheets.Add.Name = "temp_mail"
ThisWorkbook.Worksheets("Tu_Mail").Range("a4:b18").Copy
ThisWorkbook.Worksheets("temp_mail").Range("a1").Select
ActiveSheet.Paste

ThisWorkbook.Worksheets("trend").Range("a1:x93").Copy
ThisWorkbook.Worksheets("temp_mail").Range("a19").Select
ActiveSheet.Paste

ThisWorkbook.Worksheets("temp_mail").Range("a1:x93").Copy
worddoc.Range.PasteExcelTable linkedtoexcel:=False, wordformatting:=False, RTF:=False
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("temp_mail").Delete

End Sub

有没有办法将两张纸上的内容一张一张地粘贴到邮件正文中，而不是将它们合并到一张纸中。即粘贴为两个不同的表，以便列对齐保持不变。

或者

还有其他更好的方法吗？

【问题讨论】：

查看这个非常方便的RangeToHTML 函数。每当我想将 Excel 范围粘贴到电子邮件正文中时，我都会使用它。
谢谢斯科特。我试过了，RangeToHTML 是我在网络上的大多数答案中看到的常见功能。但在我的情况下它失败了，它不会复制图表。
您可以将图表复制为图片，然后将其粘贴到电子邮件正文中吗？
我将其保留为最后一个选项，因为保存图片会降低图表的质量，从而破坏我的电子邮件的整洁度。

标签： vba excel outlook

【解决方案1】：

这是我最终得到的方法

方法：

将 sheet1 内容复制到临时工作表
将 sheet2（图表）内容作为图片复制到临时工作表。

现在，我已经知道将图表复制为图片了
我之前一直忽略此方法，因为我无法导出将图表转换为高质量的图像，没有扭曲的文本和图形线。
在这种方法中，我使用了CopyPicture 函数，该函数能够以图像的形式获取图形内容。

下面是我的最终代码

Sub copy_graph()

Dim rgExp As Range
Set outlookapp = CreateObject("outlook.application")
Set OutMail = outlookapp.createitem(olmailitem)
OutMail.display
Set worddoc = OutMail.getinspector.wordeditor

ThisWorkbook.Sheets.Add
ActiveSheet.Name = "temp"
ThisWorkbook.Worksheets("temp").Range("a:z").Delete
ThisWorkbook.Worksheets("temp").Columns("a:a").ColumnWidth = 25.57
ThisWorkbook.Worksheets("temp").Columns("b:b").ColumnWidth = 89.57

'Copy contents from sheet1
ThisWorkbook.Worksheets("Mail").Range("a5:b18").Copy
ThisWorkbook.Worksheets("temp").Range("a1").Select
ThisWorkbook.Worksheets("temp").Paste

'Copy contents from sheet2 as picture
Set rgExp = ThisWorkbook.Worksheets("graph").Range("a1:x93")
rgExp.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
ThisWorkbook.Worksheets("temp").Range("a19").Select
ThisWorkbook.Worksheets("temp").Paste
ThisWorkbook.Worksheets("temp").Range("a1:t105").Copy
worddoc.Range.PasteExcelTable linkedtoexcel:=False, wordformatting:=False, RTF:=False

Application.DisplayAlerts = False

ThisWorkbook.Worksheets("temp").Delete

End Sub

【讨论】：