Как скопировать диапазон ячеек в виде растровых изображений в теле письма?

У меня есть 7 разных диапазонов ячеек, которые мне нужно скопировать и вставить в виде растровых изображений в тело моего электронного письма.

Диапазоны: E3, V29; е30, в54; е55, в80; е81, v145; х3, аф8; х9, аф37; е3, v180

Sub Criaremail()

    Dim Outlook As Object
    Dim email As Object
    Dim xInspect As Object
    Dim pageEditor As Object

    assunto = Sheets("Corpo do Email").Range("AH1")
    para = Sheets("Corpo do Email").Range("AH2")

    Set Outlook = CreateObject("Outlook.application")
    Set email = Outlook.CreateItem(0)

    With email
        .Display
        .Subject = assunto
        .To = para
        .Body = ""

    Set xInspect = email.GetInspector
    Set pageEditor = xInspect.WordEditor

    Sheets("Corpo do Email").Range("E3:V29").Copy

    pageEditor.Application.Selection.Start = Len(.Body)
    pageEditor.Application.Selection.End = 
    pageEditor.Application.Selection.Start
    pageEditor.Application.Selection.PasteSpecial (wdPasteBitmap)
    .Display

    Set pageEditor = Nothing
    Set xInspect = Nothing

    End With

    Set email = Nothing
    Set Outlook = Nothing

End Sub

stackoverflow.com/questions/29092999/…

— 30.05.2019 03:39

Возможный дубликат Вставка диапазона Excel в электронное письмо в виде изображения

— 30.05.2019 03:40

excel vba outlook

30.05.2019 02:55

Преобразование HTML-таблицы в профессиональный документ Excel

Это самый простой способ создания Excel из HTML-таблицы.

Импорт excel в laravel в базу данных

Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...

696

Перейти к ответу Данный вопрос помечен как решенный

Ответы 1

Ответ принят как подходящий

Вы можете либо скопировать каждый из 7 диапазонов по отдельности, либо зациклиться на каждой области мультидиапазона.
Я добавил два варианта вставки: Вставить как диаграмму или как растровое изображение.
С моим кодом вы также сохраните свою подпись электронной почты по умолчанию.

Sub Criaremail()

    Dim Outlook As Object
    Dim email As Object
    Dim xInspect As Object
    Dim pageEditor As Object
    Dim assunto As String, para As String
    Dim myRange As Excel.Range

    assunto = Sheets("Corpo do Email").Range("AH1")
    para = Sheets("Corpo do Email").Range("AH2")

    Set Outlook = CreateObject("Outlook.application")
    Set email = Outlook.CreateItem(0)

    With email
        .Subject = assunto
        .To = para

        Set xInspect = email.GetInspector
        Set pageEditor = xInspect.WordEditor

        pageEditor.Range.Characters(1).Select
        With pageEditor.Application.Selection
            .Collapse 1                 ' 1 = wdCollapseStart
            .InsertAfter "Hi," & vbCrLf & vbCrLf & _
                     "here's the info:" & vbCrLf
            .Collapse 0                 ' 0 = wdCollapseEnd
            For Each myRange In Sheets("Corpo do Email") _
                .Range( _
                "E3:V29, E30:V54, E55:V80, E81:V145, X3:AF8, X9:AF37, E3:V180" _
                ).Areas
                myRange.Copy
                '.PasteAndFormat Type:=13       ' 13 = wdChartPicture
                .PasteSpecial DataType:=4       ' 4 = wdPasteBitmap
                .InsertParagraphAfter
                .Collapse 0
            Next myRange
            .InsertAfter "Best wishes,"
            .Collapse 0
        End With
        .Display

        Set pageEditor = Nothing
        Set xInspect = Nothing

    End With

    Set email = Nothing
    Set Outlook = Nothing

End Sub

Как я могу изменить этот код, чтобы вставить изображение в виде растрового изображения и сделать это еще для 7 разных диапазонов в одном и том же теле письма?

— 30.05.2019 20:33

30.05.2019 08:13