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

Question

我正在从 Excel (Office 2013) 创建 Outlook 电子邮件。我想将一系列单元格 (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 中测试过的有效示例:

'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

结果:

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

或者，您可以忘记引用并使用后期绑定(bind)，将所有 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

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