Вставьте текст и несколько диапазонов Excel в качестве изображений в Outlook, используя wordeditor - PullRequest
Новая
       6

Вставьте текст и несколько диапазонов Excel в качестве изображений в Outlook, используя wordeditor

0 голосов
/ 06 декабря 2018

Я пытаюсь вставить несколько диапазонов Excel в качестве изображений в почту Outlook, используя VBA.Я использую ответ на этот вопрос ( Вставка диапазона Excel в электронное письмо в виде картинки ), чтобы вставить диапазон Excel в качестве изображения в почте, но как только я вставляю другой диапазон, оно перезаписывает предыдущее изображение,Есть ли в любом случае изменить положение курсора в почте Outlook, используя wordeditor.Я пробовал использовать коллапс перед вставкой изображения, но это не помогло.Также, как мне добавить к нему текст, так как использование 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 голосов
/ 06 декабря 2018

Вы можете обратиться к приведенному ниже коду: 

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

Для получения дополнительной информации, пожалуйста, обратитесь к этим ссылкам:

Скопировать диапазон Excel как изображение в Outlook

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

...