提示:其它语言是由 Google 机器翻译的。 你可以访问 English 版本。
登录
x
or
x
x
注册账户
x

or

如何在Excel中将一系列单元格粘贴到邮件正文中作为图像?

如果在从Excel发送电子邮件时需要复制一系列单元格并将其作为图像粘贴到邮件正文中。 你怎么处理这个任务?

使用Excel中的VBA代码将一系列单元格粘贴到电子邮件正文中


使用Excel中的VBA代码将一系列单元格粘贴到电子邮件正文中


可能没有其他好方法可以解决这个工作,本文中的VBA代码可以帮助你。 请这样做:

1。 启用要复制的工作表并将其粘贴为图像,按住 ALT + F11 键打开 Microsoft Visual Basic for Applications 窗口。

2。 点击 插页 > 模块,并将以下代码粘贴到 模块 窗口。

VBA代码:将一系列单元格粘贴到电子邮件正文中作为图像:

Sub sendMail()
        Dim TempFilePath As String
        Dim xOutApp As Object
        Dim xOutMail As Object
        Dim xHTMLBody As String
        Dim xRg As Range
        On Error Resume Next
        Set xRg = Application.InputBox("Please select the data range:", "KuTools for Excel", Selection.Address, , , , , 8)
        If xRg Is Nothing Then Exit Sub
        With Application
            .Calculation = xlManual
            .ScreenUpdating = False
            .EnableEvents = False
        End With
        Set xOutApp = CreateObject("outlook.application")
        Set xOutMail = xOutApp.CreateItem(olMailItem)
        Call createJpg(ActiveSheet.Name, xRg.Address, "DashboardFile")
        TempFilePath = Environ$("temp") & "\"
        xHTMLBody = "<span LANG=EN>" _
                & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
                & "Hello, this is the data range that you want:<br> " _
                & "<br>" _
                & "<img src='cid:DashboardFile.jpg'>" _
                & "<br>Best Regards!</font></span>"
        With xOutMail
            .Subject = ""
            .HTMLBody = xHTMLBody
          .Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue
            .To = " "
            .Cc = " "
            .Display
        End With
End Sub
Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
    Dim xRgPic As Range
    ThisWorkbook.Activate
    Worksheets(SheetName).Activate
    Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
    xRgPic.CopyPicture
    With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\" & nameFile & ".jpg", "JPG"
    End With
    Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set xRgPic = Nothing
End Sub

注意:在上面的代码中,您可以根据需要更改正文内容和电子邮件地址。

3。 插入代码后,按 F5 键运行此代码,会弹出一个对话框提醒您选择要插入到电子邮件正文中的数据范围,如图所示,请参阅截图:

4. 然后点击 OK 按钮和a 留言 - 请写下您的需求,我们尽快为您服务 窗口显示,所选的数据范围已经作为图像插入到主体中,请参阅屏幕截图:

注意: 在里面 留言 - 请写下您的需求,我们尽快为您服务 窗口,您还可以根据需要更改“收件人”和“抄送”字段中的正文内容和电子邮件地址。

5。 最后点击 发送 按钮发送此电子邮件。


注意:如果您需要粘贴来自不同工作表的多个范围,以下VBA代码可以帮到您:

首先,您应该选择要作为图片插入电子邮件正文的多个范围,然后应用以下代码:

VBA代码:将多个单元格区域粘贴到电子邮件正文中作为图像:

Sub sendMail()
    Dim TempFilePath As String
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xHTMLBody As String
    Dim xRg As Range
    Dim xSheet As Worksheet
    Dim xAcSheet As Worksheet
    Dim xFileName As String
    Dim xSrc As String
    On Error Resume Next
    TempFilePath = Environ$("temp") & "\RangePic\"
    If Len(VBA.Dir(TempFilePath, vbDirectory)) = False Then
      VBA.MkDir TempFilePath
    End If
    Set xAcSheet = Application.ActiveSheet
    For Each xSheet In Application.Worksheets
        xSheet.Activate
        Set xRg = xSheet.Application.Selection
        If xRg.Cells.Count > 1 Then
            Call createJpg(xSheet.Name, xRg.Address, "DashboardFile" & VBA.Trim(VBA.Str(xSheet.Index)))
        End If
    Next
    xAcSheet.Activate
    With Application
        .Calculation = xlManual
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set xOutApp = CreateObject("outlook.application")
    Set xOutMail = xOutApp.CreateItem(olMailItem)
    xSrc = ""
    xFileName = Dir(TempFilePath & "*.*")
    Do While xFileName <> ""
        xSrc = xSrc + VBA.vbCrLf + "<img src='cid:" + xFileName + "'><br>"
        xFileName = Dir
        If xFileName = "" Then Exit Do
    Loop
    xHTMLBody = "<span LANG=EN>" _
                & "<p class=style2><span LANG=EN><font FACE=Calibri SIZE=3>" _
                & "Hello, this is the data range that you want:<br> " _
                & "<br>" _
                & xSrc _
                & "<br>Best Regards!</font></span>"
    With xOutMail
        .Subject = ""
        .HTMLBody = xHTMLBody
        xFileName = Dir(TempFilePath & "*.*")
        Do While xFileName <> ""
            .Attachments.Add TempFilePath & xFileName, olByValue
            xFileName = Dir
        If xFileName = "" Then Exit Do
        Loop
        .To = " "
        .Cc = " "
       .Display
    End With
    If VBA.Dir(TempFilePath & "*.*") <> "" Then
        VBA.Kill TempFilePath & "*.*"
    End If
End Sub
Sub createJpg(SheetName As String, xRgAddrss As String, nameFile As String)
    Dim xRgPic As Range
    ThisWorkbook.Activate
    Worksheets(SheetName).Activate
    Set xRgPic = ThisWorkbook.Worksheets(SheetName).Range(xRgAddrss)
    xRgPic.CopyPicture
    With ThisWorkbook.Worksheets(SheetName).ChartObjects.Add(xRgPic.Left, xRgPic.Top, xRgPic.Width, xRgPic.Height)
        .Activate
        .Chart.Paste
        .Chart.Export Environ$("temp") & "\RangePic\" & nameFile & ".jpg", "JPG"
    End With
    Worksheets(SheetName).ChartObjects(Worksheets(SheetName).ChartObjects.Count).Delete
Set xRgPic = Nothing
End Sub


Excel生产力工具

Kutools for Excel - 最佳办公生产力工具

  • 为300带来强大的高级功能,使您能够更智能,更快速,更好地完成任务。
  • 不再需要记忆公式和VBA代码,从现在起让你的大脑休息一下。
  • 成为3分钟的Excel专家,复杂和重复的操作可以在几秒钟内完成,
  • 每天减少成千上万的键盘和鼠标操作,现在告别职业病。
  • 110,000高效人才和300 +世界知名公司的选择。
  • 60-day full功能免费试用。 60天退款保证。 2多年的免费升级和支持。

Office选项卡 - 为Office提供选项卡式界面,使您的工作更轻松。

  • 在Word,Excel,PowerPoint,Publisher,Access,Visio和Project中启用选项卡式编辑和阅读。
  • 在同一窗口的新选项卡中打开并创建多个文档,而不是在新窗口中。
  • 通过50%提高您的工作效率,每天为您减少数百次鼠标点击!
Say something here...
symbols left.
You are guest ( Sign Up? )
or post as a guest, but your post won't be published automatically.
Loading comment... The comment will be refreshed after 00:00.
  • To post as a guest, your comment is unpublished.
    greg horton · 5 months ago
    This is awesome, I love it! Quick question. I see that it is adding a border to the image. Is there a way to generate without a border? Thanks in advance!
    • To post as a guest, your comment is unpublished.
      Ian Wildman · 4 months ago
      I'd love to know how to paste without generating a border as well. This code is awesome, super intuitive and straightforward. Thank you!
  • To post as a guest, your comment is unpublished.
    Piotrek · 1 years ago
    wyrzuca mi błąd w linijce "Set xOutMail = xOutApp.CreateItem(olMailItem)" olMailItem - nie zdefiniowana
    oraz ".Attachments.Add TempFilePath & "DashboardFile.jpg", olByValue" olByValue - nie zdefiniowana