以编程方式将Excel图表/范围粘贴为电子邮件
如何在电子邮件中将一系列单元格和图表粘贴为增强型元文件？ 我有这个代码：
Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .Display End With Signature = OutMail.HTMLBody With OutMail .To = "me@gmail.com" .CC = "me@school.edu" .Subject = Date & " is Today's date" .HTMLBody = emailBody & vbNewLine & RangetoHTML(Range("V9:AX89")) & "Chart 1" & RangetoHTML(Range("V126:AA202")) & chart3 & RangetoHTML(Range("V210:AX222")) & vbNewLine & "This message was automated. Please respond if something is wrong with it. Thanks!" .Display End With 这种粘贴的范围不是增强的图元文件图像，而是“excel样式”文本。 （请参阅注释中的更多内容。）
如何更改此代码，使范围是增强元文件。
另外，在我的代码中"Chart 1"和"Chart 2" ，我希望那些实际粘贴名为Chart 1和Chart 2作为增强图元文件。
注意：emailBody是一个文本string，而rangeToHTML是我借用的一个函数。
Function RangetoHTML(rng As Range) ' Changed by Ron de Bruin 28-Oct-2006 ' Working in Office 2000-2016 Dim fso As Object Dim ts As Object Dim TempFile As String Dim TempWB As Workbook TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm" 'Copy the range and create a new workbook to past the data in rng.Copy Set TempWB = Workbooks.Add(1) With TempWB.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial xlPasteValues, , False, False .Cells(1).PasteSpecial xlPasteFormats, , False, False .Cells(1).Select Application.CutCopyMode = False On Error Resume Next .DrawingObjects.Visible = True .DrawingObjects.Delete On Error GoTo 0 End With 'Publish the sheet to a htm file With TempWB.PublishObjects.Add( _ SourceType:=xlSourceRange, _ Filename:=TempFile, _ Sheet:=TempWB.Sheets(1).Name, _ Source:=TempWB.Sheets(1).UsedRange.Address, _ HtmlType:=xlHtmlStatic) .Publish (True) End With 'Read all data from the htm file into RangetoHTML Set fso = CreateObject("Scripting.FileSystemObject") Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2) RangetoHTML = ts.readall ts.Close RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _ "align=left x:publishsource=") 'Close TempWB TempWB.Close savechanges:=False 'Delete the htm file we used in this function Kill TempFile Set ts = Nothing Set fso = Nothing Set TempWB = Nothing End Function