VBA：将表格从Excel发送到Outlook [重复]

Question

此问题已经在这里有了答案：

Pasting an Excel range into an email as a picture（1个答案）

Paste Excel range in Outlook（2个答案）

[<16天前关闭。

是否可以将表格从excel发送到Outlook？我想以图像（位图）的形式发送表格，因此格式仍然不错。

我有2个表格，其中包含Excel中的数据，我每天都需要发送。我想使它更平滑。

目前我有此代码：

Sub SendEmail()

Dim OutlookApp As Object
Dim OutlookMessage As Object


Sheets("SHEET1").Range("B5:AE37").Select
Selection.Copy


On Error Resume Next
Set OutlookApp = GetObject(class:="Outlook.Application")
Err.Clear
If OutlookApp Is Nothing Then Set OutlookApp = CreateObject(class:="Outlook.Application")

Set OutlookMessage = OutlookApp.CreateItem(0)

On Error Resume Next
    With OutlookMessage
     .display
     .To = "[email protected]"
     .Subject = "TEST"
     .body = Selection.Paste 'THIS IS NOT CORRECT. HOW DO I PASTE THE TABLE HERE?? Can I paste as Bitmap?
    End With
On Error GoTo 0

End Sub

此代码将打开Outlook，但不会粘贴任何内容。有什么建议么？如果我也想从sheet2粘贴第二张表怎么办？

Answer 1

应用上面评论中提到的链接中的代码

Sub SendEmail()

    Dim OutlookApp As Object
    Dim OutlookMessage As Object


    Dim rg As Range
    Set rg = Worksheets("SHEET1").Range("B5:AE37")
    rg.CopyPicture



    On Error Resume Next
    Set OutlookApp = GetObject(class:="Outlook.Application")
    Err.Clear
    If OutlookApp Is Nothing Then Set OutlookApp = CreateObject(class:="Outlook.Application")

    Set OutlookMessage = OutlookApp.CreateItem(0)

    Dim wordDoc As Object 'Word.Document
    Set wordDoc = OutlookMessage.GetInspector.WordEditor

    On Error Resume Next
    With OutlookMessage
        .display
        .To = "[email protected]"
        .Subject = "TEST"
        wordDoc.Range.pasteandformat 13

    End With
    On Error GoTo 0

End Sub