如何将Excel工作表中的文本和图表复制到Outlook正文中?

我试图复制文本(恒定范围的单元格)和Excel表格中的图表到Outlook主体,但是到目前为止,我成功地只复制图表,而不是文本。 我想知道从excel表格复制文本(在选定的范围内)和图表的最佳方式到Outlook消息。 下面是我现在使用的代码。 此代码确实粘贴文本,但图表重叠在文本上(当图表粘贴到电子邮件正文中时)。 我想如何格式化Outlook电子邮件并粘贴文本和图表不重叠。

Sub email_Charts(sFileName, Subject1) Dim r As Integer Dim o As Outlook.Application Dim m As Outlook.MailItem Dim wEditor As Word.Document Set o = New Outlook.Application Dim olTo As String Windows("Daily_Status_Macro_Ver3.0.xlsm").Activate Sheets("Main").Select olTo = Worksheets("Main").Cells(3, 3).Value Windows(sFileName).Activate msg = "<HTML><font face = Calibri =2>" msg = msg & "Hi All, <br><br>" msg = msg & "Please find Daily Status Below " msg = msg & "<b><font color=#0033CC>" msg = msg & Sheets(1).Range("B2:B4") Set m = o.CreateItem(olMailItem) m.To = olTo m.Subject = Subject1 m.BodyFormat = olFormatHTML m.HTMLBody = msg m.Display Windows(sFileName).Activate Sheets(1).Select ActiveSheet.DrawingObjects.Select Selection.Copy Set wEditor = o.ActiveInspector.wordeditor m.Body = msg wEditor.Application.Selection.Paste 'm.send Workbooks(sFileName).Close SaveChanges:=False End Sub 

也许是这样的:

 Sub createJpg(Namesheet As String, nameRange As String, nameFile As String) ThisWorkbook.Activate Worksheets(Namesheet).Activate Set Plage = ThisWorkbook.Worksheets(Namesheet).Range(nameRange) Plage.CopyPicture With ThisWorkbook.Worksheets(Namesheet).ChartObjects.Add(Plage.Left, Plage.Top, Plage.Width, Plage.Height) .Activate .Chart.Paste .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG" End With Worksheets(Namesheet).ChartObjects(Worksheets(Namesheet).ChartObjects.Count).Delete Set Plage = Nothing End Sub 

并在您现有的代码中:

 Set appOutlook = CreateObject("outlook.application") 'create a new message Set Message = appOutlook.CreateItem(olMailItem) With Message .HTMLBody = "Hello" ' and whatever else you need in the text body 'first we create the image as a JPG file Call createJpg("Dashboard", "B8:H9", "DashboardFile") 'we attached the embedded image with a Position at 0 (makes the attachment hidden) TempFilePath = Environ$("temp") & "\" .Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue, 0 'Then we add an html <img src=''> link to this image 'Note than you can customize width and height - not mandatory .HTMLBody = .HTMLBody & "<br><B>WEEKLY REPPORT:</B><br>" _ & "<img src='cid:DashboardFile.jpg'" & "width='814' height='33'><br>" _ & "<br>Best Regards,<br>Ed</font></span>" .To = "contact1@email.com; contact2@email.com" .Cc = "contact3@email.com" .Display '.Send End With