如何使用 Word 编辑器（作为图像）将多个表格范围粘贴到 Outlook 正文中

Question

我可以毫无问题地将一个 excel 范围粘贴到 Outlook（作为图像）中，但是在将多个范围粘贴到 Outlook 正文中（在单独的行上）时，我遇到了格式问题。

我正在尝试粘贴一个范围，插入一个“换行符”，然后粘贴另一个范围，依此类推。我尝试了各种分离图像的方法，但没有任何效果。图像粘贴成功，但仅在一行上，这使得所有内容都无法对齐。

Sub SendEmail()

    Dim olApp As Outlook.Application
    Dim olEmail As Outlook.MailItem
    Dim olInsp As Outlook.Inspector
    Dim wdDoc As Word.document
    Dim strGreeting As String

    strGreeting = "Dear Someone," & vbNewLine

    Set olApp = New Outlook.Application
    Set olEmail = olApp.CreateItem(olMailItem)

    With olEmail
        .BodyFormat = olFormatRichText
        .display

        .To = "Someone@tester.com"
        .Subject = "Report"

        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor

        wdDoc.Range.InsertBefore strGreeting


        ' This is where I am having problems:
        ' The tables are pasting into the document out of order (not a huge problem) but...
        ' the images paste on ONE single line, I need the images to paste on a new line so they
        ' format vertically along the body of the email.

        'Range #1 one to copy/paste into outlook body
        Range("W2:AB40").Copy
        wdDoc.Range(Len(strGreeting) & vbCrLf, Len(strGreeting)).PasteAndFormat wdChartPicture
        wdDoc.Range.InsertAfter vbCrLf

        'Range #2 one to copy/paste into outlook body
        Range("E2:I26").Copy
        wdDoc.Range(Len(strGreeting) & vbCrLf, Len(strGreeting)).PasteAndFormat wdChartPicture
        wdDoc.Range.InsertAfter vbCrLf

        'Range #3 one to copy/paste into outlook body
        Range("N38:V50").Copy
        wdDoc.Range(Len(strGreeting) & vbCrLf, Len(strGreeting)).PasteAndFormat wdChartPicture
        wdDoc.Range.InsertAfter vbCrLf

        'Range #4 one to copy/paste into outlook body
        If shtWash.Range("SHIFT_GROUP") = "DAYS" Then
            Range("N2:V18").Copy
        Else
            Range("N2:V36").Copy
        End If
        wdDoc.Range(Len(strGreeting) & vbCrLf, Len(strGreeting)).PasteAndFormat wdChartPicture
        wdDoc.Range.InsertAfter vbCrLf

        'Range #5 one to copy/paste into outlook body
        Range("E28:I34").Copy
        wdDoc.Range(Len(strGreeting) & vbCrLf, Len(strGreeting)).PasteAndFormat wdChartPicture
        wdDoc.Range.InsertAfter vbCrLf

    End With

End Sub

Answer 1

这对我有用：

Sub SendEmail()

    Dim olApp As Outlook.Application
    Dim olEmail As Outlook.MailItem
    Dim olInsp As Outlook.Inspector
    Dim wdDoc As Word.Document
    Dim strGreeting As String

    strGreeting = "Dear Someone," & vbNewLine

    Set olApp = New Outlook.Application
    Set olEmail = olApp.CreateItem(olMailItem)

    With olEmail
        .BodyFormat = olFormatRichText
        .display

        .To = "Someone@tester.com"
        .Subject = "Report"

        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor

        wdDoc.Range.InsertBefore strGreeting

        wdDoc.Range.InsertAfter vbCrLf

        Range("A1:D10").Copy
        PasteAtEnd wdDoc

        wdDoc.Range.InsertAfter vbCrLf & vbCrLf

        Range("A12:D20").Copy
        PasteAtEnd wdDoc

    End With

End Sub

'paste from clipboard to the end of the document
Sub PasteAtEnd(doc As Word.Document)
    With doc
        .Content.Select
        .Application.Selection.Collapse (wdCollapseEnd)
        .Application.Selection.PasteAndFormat wdChartPicture
    End With
End Sub