使用wordeditor在Outlook中将文本和多个Excel范围粘贴为图像

时间:2018-12-05 21:34:44

标签: excel vba outlook

我正在尝试使用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

1 个答案:

答案 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