使用 Excel VBA 将图片粘贴到 Outlook 邮件中的文本上

1 excel outlook vba copy-paste range

我正在尝试将 Excel 中的范围作为图片复制到 Outlook 邮件,并在正文中添加文本。

我的代码是添加文本,然后将图片粘贴在其上。如何将其粘贴到文本下方?

Dim OutApp As Object
Dim outMail As Object
Dim myFileList(1) As String
Dim i As Long

Set OutApp = CreateObject("Outlook.Application")
Set outMail = OutApp.CreateItem(0)

Set RngCopied = Worksheets("Daily volume summary").Range("VolumeRange")

myFileList(0) = "Y:xyz\sales.pdf"
myFileList(1) = "Y:xyz\sales.xlsx"

'On Error Resume Next
With outMail
    .To = "abc@xyz.com"
    .CC = "def@xyz.com"
    .BCC = ""
    .Subject = "PBC Daily Sales  " & Format(Date, "mm/dd/yyyy")
    .Body = "Good morning," & vbNewLine & vbNewLine & "Attach is the Daily Sales report for  " & Format(Date, "dddd,mmmm,dd,YYYY") & "." & "<br>" 

    'Copy range of interest

    Dim r As Range

    Set r = Worksheets("Daily volume summary").Range("VolumeRange") 
    r.Copy

    'Get its Word editor 
    outMail.Display
    Dim wordDoc As Word.Document
    Set wordDoc = outMail.GetInspector.WordEditor

    'To paste as picture
    wordDoc.Range.PasteAndFormat wdChartPicture
    Dim shp As Object
    For Each shp In wordDoc.InlineShapes
        shp.ScaleHeight = 60
        shp.ScaleWidth = 60
    Next

    For i = 0 To UBound(myFileList)
        .Attachments.Add myFileList(i)
    Next

    .Send
End With
On Error GoTo 0

Set outMail = Nothing
Set OutApp = Nothing
End Sub
Run Code Online (Sandbox Code Playgroud)

Opi*_*Dad 5

在行中:

 wordDoc.Range.PasteAndFormat wdChartPicture
Run Code Online (Sandbox Code Playgroud)

您正在用您的图片替换消息的 Word 文档的整个范围。相反,您需要记下要将其粘贴到范围内的位置。这应该放在你的文本后面:

 wordDoc.Range(start:=wordDoc.Range.End - 2).PasteAndFormat wdChartPicture
Run Code Online (Sandbox Code Playgroud)