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

Pasting an Excel range into an email as a picture

提问by Sean Davids

I'm creating an Outlook email from Excel (Office 2013). I want to paste a range of cells (C3:S52) into the email as a picture.

我正在从 Excel (Office 2013) 创建 Outlook 电子邮件。我想将一系列单元格 (C3:S52) 作为图片粘贴到电子邮件中。

Below is the code I have so far. Where am I going wrong?

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

 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 

回答by Jean-Fran?ois Corbett

Here's a worked example, tested in Office 2010:

这是一个在 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 code above I used early binding to have access to autocomplete; to use this code you need to set references to the Microsoft Outlook and Microsoft Word object libraries: Tools> References...> set checkmarks like this:

在上面的代码中，我使用了早期绑定来访问自动完成；要使用此代码，您需要设置对 Microsoft Outlook 和 Microsoft Word 对象库的引用：Tools> References...> 像这样设置复选标记：

Alternatively, you can forget about the references and use late binding, declaring all the Outlook and Word objects As Objectinstead of As Outlook.Applicationand As Word.Documentetc.

或者，你可以忘掉的引用和使用后期绑定，宣布所有的Outlook和Word对象As Object，而不是As Outlook.Application和As Word.Document等。

---

---

Apparently you're having trouble implementing the above; the range pastes as a table rather than a picture in your email message. I have no explanation for why that would happen.

显然，您在执行上述操作时遇到了麻烦；该范围在您的电子邮件中粘贴为表格而不是图片。我无法解释为什么会发生这种情况。

An alternative is then to paste as an image in Excel, and then cut and paste that image into your e-mail:

另一种方法是在 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

As pointed out by WizzleWuzzle, there is also the option of using PasteSpecialinstead of PasteAndFormator Paste...

正如WizzleWuzzle所指出的，还可以选择使用PasteSpecial代替PasteAndFormat或Paste...

wordDoc.Range.PasteSpecial , , , , wdPasteBitmap

... but for some reason, the resulting image doesn't render as well. See how the lower table is kind of blurry:

...但由于某种原因，生成的图像也无法呈现。看看下面的表格有点模糊：