将 Excel 范围作为图片粘贴到电子邮件中 [英] Pasting an Excel range into an email as a picture

问题描述

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

以下是我目前的代码.我哪里出错了?

 Sub Button193_Click()'' Button193_Click 宏''ActiveWindow.ScrollColumn = 2ActiveWindow.ScrollColumn = 1范围(C3:S52").选择选择.复制结束子子创建邮件()Dim objOutlook 作为对象Dim objMail 作为对象变暗为范围将主题变暗为范围将主体变暗为范围Dim rngAttach As RangeSet objOutlook = CreateObject("Outlook.Application")设置 objMail = objOutlook.CreateItem(0)使用 ActiveSheet设置 rngTo = .Range("E55")设置 rngSubject = .Range("E56")设置 rngBody = .Range("E57")结束于使用 objMail.To = rngTo.Value.Subject = rngSubject.Value.Body = rngBody.Value.Display '代替 .Display，你可以使用 .Send 来发送电子邮件 _或 .Save 将副本保存在草稿文件夹中结束于设置 objOutlook = 无设置 objMail = 无设置 rngTo = 无设置 rngSubject = 无设置 rngBody = 无设置 rngAttach = 无结束子子 Button235_Click()'' Button235_Click 宏''ActiveWindow.ScrollColumn = 2ActiveWindow.ScrollColumn = 1范围(A1:M27").选择选择.复制结束子子 RunThemAll()Application.RunButton193_Click"Application.Run创建邮件"结束子

解决方案

这是一个在 Office 2010 中测试过的有效示例:

'复制感兴趣的范围调暗范围设置 r = Range("B2:D5")r. 复制'打开一个新的邮件项目将 OutlookApp 调暗为 Outlook.Application设置 OutlookApp = CreateObject("Outlook.Application")将 outMail 变暗为 Outlook.MailItem设置 outMail = outlookApp.CreateItem(olMailItem)'获取它的 Word 编辑器邮件显示将 wordDoc 变暗为 Word.Document设置 wordDoc = outMail.GetInspector.WordEditor'粘贴为图片wordDoc.Range.PasteAndFormat wdChartPicture'粘贴为表格'wordDoc.Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

结果:

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

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

<小时>

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

另一种方法是在 Excel 中粘贴为图像，然后将该图像剪切并粘贴到您的电子邮件中:

'复制感兴趣的范围调暗范围设置 r = Range("B2:D5")r. 复制'将图片粘贴到工作表中并立即剪切调暗为图片设置 p = ActiveSheet.Pictures.Pastep.Cut'打开一个新的邮件项目将 OutlookApp 调暗为 Outlook.Application设置 OutlookApp = CreateObject("Outlook.Application")将 outMail 变暗为 Outlook.MailItem设置 outMail = outlookApp.CreateItem(olMailItem)'获取它的 Word 编辑器邮件显示将 wordDoc 变暗为 Word.Document设置 wordDoc = outMail.GetInspector.WordEditor'粘贴图片wordDoc.Range.Paste

正如

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.

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 

解决方案

Here's a worked 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 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:

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

---

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:

'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 PasteSpecial instead of PasteAndFormat or 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:

这篇关于将 Excel 范围作为图片粘贴到电子邮件中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！