Question

我发现该帖子的解决方案非常有帮助 Copy Excel range as Picture to Outlook

但是，我希望有人在使用时可以帮助扩展解决方案

wdDoc.Range.PasteAndFormat Type:=wdChartPicture in .HTMLBody

我想在“早上好，数字在下面的图片中更新”之后但在表格和“亲切的问候”之前粘贴图片：

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("Summary")
Set rng = Sht.Range("A4:M12")
    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 = ""
    .HTMLBody = "Good Morning,<br><br>Figures updated in Image below:<br><br>"

     wdDoc.Range.PasteAndFormat Type:=wdChartPicture

    .HTMLBody = .HTMLBody & "<table>" _
        & "<TH>" & ThisWorkbook.Worksheets("Summary").Range("E14").Value & "</h1>" _
        & "<TH>" & ThisWorkbook.Worksheets("Summary").Range("F14").Value & "</h1>" _
            & "<TR><TD>" & ThisWorkbook.Worksheets("Summary").Range("E15").Value & "</td>" _
            & "<TD>" & ThisWorkbook.Worksheets("Summary").Range("F15").Value & "</td>" _
    & "</table>" _
    & "<br>Kind Regards<br>"

    .Display
End With

With Application
    .EnableEvents = True
    .ScreenUpdating = True
End With

Set Email = Nothing
Set olApp = Nothing

End Sub

Answer 1

我更改了范围，但是在这里找到了以下内容：http://learnexcelmacro.com/wp/2016/11/send-image-of-a-range-from-excel-embedded-in-mail-inline-image-in-mail/

Option Explicit
Sub SendHTML_And_RangeImage_As_Body_UsingOutlook()
    Dim olApp As Object
    Dim NewMail As Object
    Dim ChartName As String
    Dim imgPath As String
    Dim tmpImageName As String
    Dim RangeToSend As Range
    Dim sht As Worksheet
    Dim objChart As Chart

    'On Error GoTo err

    Set olApp = CreateObject("Outlook.Application")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    'define a temp path for your image
    tmpImageName = VBA.Environ$("temp") & "\tempo.jpg"

    'Range to save as an image
    Set RangeToSend = Worksheets("Summary").Range("E14:F15")
    ' Now copy that range as a picture
    RangeToSend.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    ' To save this as an Image we need to do a workaround
    ' First add a temporary sheet and add a Chart there
    ' Resize the chart same as the size of the range
    ' Make the Chart border as Zero
    ' Later once we export that chart as an image
    ' and save it in the above temporary path
    ' will delete this temp sheet

    Set sht = Sheets.Add
    sht.Shapes.AddChart
    sht.Shapes.Item(1).Select
    Set objChart = ActiveChart

    With objChart
        .ChartArea.Height = RangeToSend.Height
        .ChartArea.Width = RangeToSend.Width
        .ChartArea.Fill.Visible = msoFalse
        .ChartArea.Border.LineStyle = xlLineStyleNone
        .Paste
        .Export Filename:=tmpImageName, FilterName:="JPG"
    End With

    'Now delete that temporary sheet
    sht.Delete

   ' Create a new mail message item.
    Set NewMail = olApp.CreateItem(0)

    With NewMail
        .Subject = "Your Subject here" ' Replace this with your Subject
        .To = "abc@email.com" ' Replace it with your actual email

'       **************************************************
'       You can desing your HTML body for this email.
'       below HTML code will display the image in
'       Body of the email. It will not go in attachment.
'       **************************************************
        .HTMLBody = "<body>Dear Sir/Madam, <br><br> Kindly find the report below:<br><br>" & _
        "<img src=" & "'" & tmpImageName & "'/> <br><br> Regards, LearnExcelMacro.com </body>"
        .display

    End With

err:

    'Release memory.
    ' Kill tmpImageName
    Set olApp = Nothing
    Set NewMail = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

如何在Outlook中将复制的Excel范围作为图片嵌入到HTMLBody中？

1 个答案: