将图形粘贴到多个电子邮件中

Question

我有一个电子表格，记录每个员工每月的绩效数据。

我在选定的员工数据上运行VBA代码，为每个员工创建电子邮件。电子邮件包含他们上个月的表现数据，但代码也创建了一个年初至今的图表，然后将其粘贴在电子邮件上。

我有两个问题。

1. 该图形粘贴在电子邮件的顶部。我怎么把它加到底部呢?

2. 当我为多个员工运行代码时，它会添加生成电子邮件的最后一个员工的图形。
   创建电子邮件的代码位于选定的每个员工的循环中。
   创建图表的代码位于此循环中，因为它将每个员工的数据拉入生成图表的表中。
   我所能想到的是，粘贴到电子邮件中的图表使用的是电子表格中当前表格中的数据，而不是创建图表时的数据。

创建邮件的主代码:

Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Dim selectedMonth As String
Dim emAddy As String
selectedMonth = Sheets("Control Panel").Range("E4").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
'generate graphs
Dim sh As Variant
Set Rng = Range("B1:M12")
For Each sh In Array("April", "May", "June", "July", "August", "September", "October", "November", "December", "January", "February", "March") 
lastrow = Sheets(sh).Range("A" & Rows.Count).End(xlUp).Row
For m = 1 To lastrow
If Sheets(sh).Range("A" & m).Value = staffList.List(i) Then
For N = 2 To 13
If Sheets("graphs").Cells(1, N).Value = sh And Sheets(sh).Range("L" & m).Value <> "NaN" Then
Sheets("graphs").Cells(2, N).Value = FormatPercent(Sheets(sh).Range("L" & m).Value): N = 13
End If
Next N
m = lastrow
End If
Next m
Next sh

On Error Resume Next
With OutMail
.From = ""
.To = emAddy
.CC = ""
.BCC = ""
.Subject = "Monthly Stats"
.HTMLbody = strbody
.Display
End With
On Error GoTo 0
Set mailApp = CreateObject("Outlook.Application")
Set mail = mailApp.CreateItem(olMailItem)

Set wEditor = mailApp.ActiveInspector.WordEditor
Sheets("graphs").ChartObjects("Chart 1").Copy

wEditor.Application.Selection.Paste

Answer 1

您必须做一些工作，以确保您有一个允许的WordEditor(请参阅本文档)，然后将插入点移动到文档的末尾。下面的例子展示了如何:

Option Explicit
Sub TestEmailWithChart()
Dim theChart As ChartObject
Set theChart = Sheet1.ChartObjects(1)
theChart.CopyPicture

Dim olApp As Outlook.Application
Set olApp = New Outlook.Application

Dim olMail As Outlook.MailItem
Set olMail = olApp.CreateItem(olMailItem)

Dim mailBody As String
mailBody = "Hello,<br><br>Here is the chart:<br><br><br>"

With olMail
.To = "[e-mail]"
.CC = vbNullString
.BCC = vbNullString
.Subject = "Test Email with Chart"
.HTMLBody = mailBody

With .GetInspector
If .IsWordMail And (.EditorType = olEditorWord) Then
Dim mailDoc As Word.Document
Set mailDoc = .WordEditor
mailDoc.Application.Selection.EndKey Unit:=wdStory
mailDoc.Application.Selection.Paste
Else
Debug.Print "Can't use the Word Editor for this email"
End If
End With

.Display
End With
End Sub