Question

我需要复制和粘贴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

Answer 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

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

1 个答案: