Question

如何在电子邮件中粘贴一系列单元格和图表作为增强型图元文件？我有这段代码：

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

这会将范围粘贴为增强型图元文件图像，而不是＆＃34; excel-style＆＃34;文本。（在说明中详细了解这一点。）

如何更改此代码，使范围成为增强的元文件。

此外，我的代码显示"Chart 1"和"Chart 2"，我希望这些代码实际上将名为Chart 1和Chart 2的图表粘贴为增强型图元文件。

注意：emailBody是一个文本字符串，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

以编程方式将Excel图表/范围粘贴为增强型图元文件到电子邮件中

0 个答案: