我正在尝试使用VBA将多个Excel范围粘贴为Outlook邮件中的图像。我正在使用此问题的答案(Pasting an Excel range into an email as a picture)将一定范围的excel作为图像粘贴到邮件中,但是一旦我粘贴另一个范围,它就会覆盖先前的图像。无论如何,是否可以使用wordeditor更改Outlook邮件中的光标位置。我尝试在粘贴图像之前使用折叠,但没有帮助。另外,当我使用Outmail.body编辑任何内容时,如何向其中添加文本,也被后来粘贴的图像覆盖。 这是我正在使用的代码:
Sub Sendmail()
Dim r as range
Set r = Range("C2:O13)
r.copy
dim outlookapp as Outlook.Application
set outlookapp = CreateObject("Outlook.Application")
dim outMail As Outlook.Mailitem
Set outMail = outlookApp.CreateItem(olMailItem)
With outMail
.Display
.CC = "xyz@abc.com"
.Subject = "Test"
.Body = "Dear" & "Macro" & vbnewline
end with
outmail.Display
'Opening wordeditor
dim worddoc as Word.Document
Set worddoc = Outmail.GetInspector.WordEditor
worddoc.range.PasteandFormat wdChartPicture
'Adding new line after pasting image
worddoc.range.Insertafter vbNewline
' Adding second image
dim s as range
set s= Range(P2:Z30)
s.copy
worddoc.range.PasteandFormat wdChartPicture
答案 0 :(得分:0)
您可以参考以下代码:
Option Explicit
Public Sub Example()
Dim rng As Range
Dim olApp As Object
Dim Email As Object
Dim Sht As Excel.Worksheet
Dim wdDoc As Word.Document
Set Sht = ActiveWorkbook.Sheets("Dashboard")
Set rng = Sht.Range("B4:L17")
rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set olApp = CreateObject("Outlook.Application")
Set Email = olApp.CreateItem(0)
Set wdDoc = Email.GetInspector.WordEditor
With Email
.To = ""
.CC = ""
.BCC = ""
.Subject = ""
.Attachments.Add ActiveWorkbook.FullName
wdDoc.Range.PasteAndFormat Type:=wdChartPicture
' if need setup inlineshapes hight & width
With wdDoc
.InlineShapes(1).Height = 130
End With
.Display
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set Email = Nothing
Set olApp = Nothing
End Sub
有关更多信息,请参阅以下链接:
Copy Excel range as Picture to Outlook
Copy range of cells from Excel as picture and add text in the email body