Excel 如何将单元格范围复制为电子邮件正文中的位图？

我有7个不同的单元格区域，需要在电子邮件正文中复制和粘贴位图图像

范围为E3、V29；e30，v54；e55，v80；e81，v145；x3，af8；x9，af37；e3，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

---

您可以单独复制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个量程中的每个量程，也可以在多量程的每个区域上循环。
我添加了两种粘贴选项：粘贴为图表或位图。
使用我的代码，您还将保留默认的电子邮件签名

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个不同范围内执行此操作？如何更改此代码以将图片粘贴为位图，并在同一电子邮件正文中的7个不同范围内执行此操作？