Как вы можете встроить скопированный диапазон Excel как изображение в HTMLBody в Outlook? - PullRequest
Новая
       13

Как вы можете встроить скопированный диапазон Excel как изображение в HTMLBody в Outlook?

1 голос
/ 29 марта 2019

Я нашел решения для поста очень полезными Копирование диапазона Excel как изображения в 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

1 Ответ

0 голосов
/ 29 марта 2019

Я изменил диапазон, но здесь было найдено ниже: 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.

Похожие темы

...