通过Outlook电子邮件发送Excel形状

我已经编写了此代码，我想通过电子邮件发送Excel中已经存在的图像（名为

Picture 1810

）。但是我无法发现如何做

.Body

有人能帮我吗

Sub CreateMail()    
    Dim objOutlook As Object
    Dim objMail As Object
    Dim rngTo As Range
    Dim rngCC As Range
    Dim rngSubject As Range
    Dim rngBody As Shape
    Dim rngAttach As Range

    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)

    With ActiveSheet
        Set rngTo = .Range("f2")
        Set rngCC = .Range("f3")
        Set rngSubject = .Range("c2")
        Set rngBody = .Shapes("Picture 1810")
    End With

    With objMail
        .To = rngTo.Value
        .CC = rngCC.Value
        .Subject = rngSubject.Value
        .Body = rnbbody
        .Send
    End With

    Set objOutlook = Nothing
    Set objMail = Nothing
    Set rngTo = Nothing
    Set rngSubject = Nothing
    Set rngBody = Nothing
    Set rngAttach = Nothing
End Sub

---

通过此操作，您可以保留标准电子邮件签名，并将形状粘贴到正文文本上方或中间的字符上：

With objMail
    .To = rngTo.Value
    .CC = rngCC.Value
    .Subject = rngSubject.Value
    .Display
    Dim wdDoc As Word.Document
    Set wdDoc = .GetInspector.WordEditor
    If Not wdDoc Is Nothing Then
        With wdDoc.Range
            .Collapse wdCollapseStart
            .InsertBefore "Hi there," & vbCrLf & "here's my shape:" & vbCrLf
            .Collapse wdCollapseEnd
            .InsertAfter vbCrLf & "Best wishes," & vbCrLf
            .Collapse wdCollapseStart

            ActiveSheet.Shapes("Picture 1810").Copy
            '.Paste ' over the text
            .PasteAndFormat wdChartPicture ' within text
        End With
        Set wdDoc = Nothing
    End If
    '.Send
End With

---

可能的重复我不想像图像一样嵌入一个单元格区域，我已经有一个图像，我想在电子邮件中设置形状或对象的范围，您必须将形状作为图像导出到文件夹中，然后按照上面的链接嵌入以导出形状，您可以将其放入图表对象中并按图中所示导出，也可以按图中所示使用Stephen Bullen的PastePicture函数进行小的更改，但效果非常好！非常感谢你！！