提问人：ZJMartin 提问时间：11/11/2023 更新时间：11/11/2023 访问量：64
无法从 Excel 复制表格并在电子邮件中粘贴为图像
Unable to Copy Table from Excel and Paste as Image in Email
问：
我正在尝试从Excel中的工作表中复制表格范围，并将其粘贴到Outlook中的电子邮件正文中。下面的脚本打开电子邮件并填充“收件人：”和“主题”行，但电子邮件的正文为空。脚本正在复制图像，因为我可以右键单击电子邮件正文并粘贴图像。它只是没有粘贴脚本。
这让我发疯了，任何帮助将不胜感激！
Sub send_email_with_table_as_pic()
Dim OutApp As Object
Dim OutMail As Object
Dim table As Range
Dim pic As Picture
Dim ws As Worksheet
Dim wordDoc
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'grab table, convert to image, and cut
Set ws = ThisWorkbook.Sheets("Sheet1")
Set table = ws.Range("E26:H38")
ws.Activate
table.Copy
Set pic = ws.Pictures.Paste
pic.Select
With Selection
.ShapeRange.LockAspectRatio = msoTrue
.ShapeRange.Height = 100
End With
pic.Cut
'create email message
On Error Resume Next
With OutMail
.to = "[email protected]"
.cc = ""
.bcc = ""
.Subject = "table data"
.display
Set wordDoc = OutMail.GetInspector.WordEditor
With wordDoc.Range
.pasteandformat wdChartPicture
.insertParagraphAfter
.InsertAfter "Thank you,"
.insertParagraphAfter
.InsertAfter "Greg"
End With
.HTMLBody = "<BODY style = font-size:11pt; font-family:Arial>" & _
"Hi team, <p> Please see table below: <p>" & .HTMLBody
End With
On Error GoTo 0
Set OutApp = Nothing
Set OutMail = Nothing
End Sub
我尝试观看YouTube教程并搜索StackOverflow和Microsoft办公帮助网站。我想知道 outlook 或 Excel 中的设置是否未正确设置。我从一个似乎对其他人有用的教程中复制了大部分代码。
答：
1赞
Tim Williams
11/11/2023
#1
这有点简单，对我有用：
Sub send_email_with_table_as_pic()
Dim OutApp As Object
Dim OutMail As Object
Dim wordDoc As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
ThisWorkbook.Sheets("Sheet1").Range("E26:H38").CopyPicture
With OutMail
.to = "[email protected]"
.cc = ""
.bcc = ""
.Subject = "table data"
.display
Set wordDoc = OutMail.GetInspector.WordEditor
With wordDoc.Range
.Paste
wordDoc.InlineShapes(1).Height = 100
.InsertParagraphAfter
.InsertAfter "Thank you,"
.InsertParagraphAfter
.InsertAfter "Greg"
End With
.HTMLBody = "<BODY style = font-size:11pt; font-family:Arial>" & _
"Hi team, <p> Please see table below: <p>" & .HTMLBody
End With
End Sub
评论
0赞
ZJMartin
11/11/2023
谢谢 Tim，我想我的工作计算机上有一个组策略设置，该设置限制了 .GetInspector 行。我在我的个人笔记本电脑上运行了您提供的代码，它第一次就起作用了。仍然无法在我的工作笔记本电脑上工作。
0赞
Tim Williams
11/11/2023
也许看看：stackoverflow.com/questions/45376329/......
0赞
artodoro
11/11/2023
#2
若要使此代码正常工作，有两种可能的解决方案：
- 将常量替换为其值 - 13。
wdChartPicture
With wordDoc.Range
.pasteandformat 13 ' <~ Replace the constant to value
.insertParagraphAfter
.InsertAfter "Thank you,"
.insertParagraphAfter
.InsertAfter "Greg"
End With
或
- 添加工具 -> 引用... -> Microsoft Word 对象库。
它对我有用：
评论
wdChartPicture是一个 Word VBA 常量，除非已在 VBA 项目中向 Word 对象库添加引用，否则 Excel 代码将不知道其值。如果你使用它，它会警告你这样的事情。Option Explicit