跳到主要内容

如何在Excel中使用vba在电子邮件中发送特定图表？

您可能知道如何使用VBA代码在Excel中通过Outlook发送电子邮件。 但是，您知道如何将特定工作表中的特定图表附加到电子邮件正文中吗？ 本文将向您展示解决此问题的方法。

使用VBA代码在Excel中通过电子邮件发送特定图表

使用VBA代码在Excel中通过电子邮件发送特定图表

请执行以下操作，以在Excel中通过VBA代码在电子邮件中发送特定图表。

1.在工作表中包含要在电子邮件正文中附加的图表，请按 其他 + F11 键打开 Microsoft Visual Basic应用程序 窗口。

2.在 Microsoft Visual Basic应用程序 窗口，请点击 插页 > 模块。 然后将下面的VBA代码复制到“代码”窗口中。

VBA代码：在Excel中通过电子邮件发送特定图表

Sub mailHTMLsend()
'Updated by Extendoffice 2018/3/5
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = Application.InputBox("Please enter the chart name:", "KuTools for Excel", , , , , , 2)
    If xChartName = "" Then Exit Sub
    Set xChart = Sheets("Sheet1").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
    If xChart Is Nothing Then Exit Sub
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    xPath = "<p align='Left'><img src=" & "cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = ""
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

备注：在代码中，请更改收件人的电子邮件地址和相应的电子邮件主题 .To = "" 和线 .Subject =“在Outlook邮件正文中添加图表” , Sheet1 是包含您要发送的图表的表格，请更改为您自己的图表。

3。 按 F5 键来运行代码。 在开幕 Kutools for Excel 对话框中，输入要附加在电子邮件正文中的图表的名称，然后单击 OK 按钮。 看截图：

然后会自动创建一封电子邮件，并在电子邮件正文中显示指定的图表，如下图所示。 请单击发送按钮发送此电子邮件。

相关文章：

 

 

 

最佳办公生产力工具

🤖 Kutools 人工智能助手：基于以下内容彻底改变数据分析： 智能执行   |  生成代码  |  创建自定义公式  |  分析数据并生成图表  |  调用 Kutools 函数...
热门特色: 查找、突出显示或识别重复项   |  删除空白行   |  合并列或单元格而不丢失数据   |   不使用公式进行四舍五入 ...
超级查询: 多条件VLookup  |   多值VLookup  |   跨多个工作表的 VLookup   |   模糊查询 ....
高级下拉列表: 快速创建下拉列表   |  依赖下拉列表   |  多选下拉列表 ....
列管理器: 添加特定数量的列  |  移动列  |  切换隐藏列的可见性状态  |  比较范围和列 ...
特色功能: 网格焦点   |  设计图   |   大方程式酒吧   |  工作簿和工作表管理器   |  资源库 （自动文本）   |  日期选择器   |  合并工作表   |  加密/解密单元格   |  按列表发送电子邮件   |  超级筛选   |   特殊过滤器 （过滤粗体/斜体/删除线...）...
前 15 个工具集:  12 文本 工具 (添加文本, 删除字符，...）   |   50+ 图表 类型 (甘特图，...）   |   40+ 实用 公式 (根据生日计算年龄，...）   |   19 插入 工具 (插入二维码, 从路径插入图片，...）   |   12 转化 工具 (小写金额转大写, 货币兑换，...）   |   7 合并与拆分 工具 (高级组合行, 分裂细胞，...）   |   ... 和更多

使用 Kutools for Excel 增强您的 Excel 技能，体验前所未有的效率。 Kutools for Excel 提供了 300 多种高级功能来提高生产力并节省时间。  单击此处获取您最需要的功能...

产品描述

Office Tab 为 Office 带来选项卡式界面，让您的工作更加轻松

  • 在Word，Excel，PowerPoint中启用选项卡式编辑和阅读，发布者，Access，Visio和Project。
  • 在同一窗口的新选项卡中而不是在新窗口中打开并创建多个文档。
  • 每天将您的工作效率提高50％，并减少数百次鼠标单击！

 

 

Comments (15)
No ratings yet. Be the first to rate!
Jyoti
Jyoti
This comment was minimized by the moderator on the site
With the above code, Chart can be seen in the Email body with the .Display.

When .Send is used to send the message, Mail dosent show chart in the Email body.
Reply
0
0
crystal
crystal     Jyoti
This comment was minimized by the moderator on the site
Hi Jyoti,

Can you tell me what version of Excel you are using? The code works fine whether I change .Display to .Send or not.
Reply
Report
0
0
pavan chougule
pavan chougule
This comment was minimized by the moderator on the site
HELLO , I want to add space in mail body , which keyword should I use.
Reply
0
0
crystal
crystal     pavan chougule
This comment was minimized by the moderator on the site
Hi pavan chougule,
The following two lines in the code contain the email body content. You can manually modify the email body by pressing the space key on your keyboard to add a space.
xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
Reply
Report
0
0
YOussef
YOussef
This comment was minimized by the moderator on the site
It includes the chart as an attachment. Do you have any idea how to include it as a picture in the mail body itself. Thank you,Youssef
Reply
0
0
J
J     YOussef
This comment was minimized by the moderator on the site
Same problem, any solution?
Reply
0
0
crystal
crystal     J
This comment was minimized by the moderator on the site
Hi J，
The code has been updated. Please give it a try. Sorry for the inconvenience.


Sub mailHTMLsend()
'Updated by Extendoffice 2018/3/5
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = Application.InputBox("Please enter the chart name:", "KuTools for Excel", , , , , , 2)
    If xChartName = "" Then Exit Sub
    Set xChart = Sheets("Sheet1").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
    If xChart Is Nothing Then Exit Sub
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    xPath = "<p align='Left'><img src="/%20&%20"cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = ""
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
Reply
Report
0
0
Kuba
Kuba     crystal
This comment was minimized by the moderator on the site
Cześć,
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
Reply
0
0
crystal
crystal     Kuba
This comment was minimized by the moderator on the site
Hi Kuba,
The code has been updated. The recipient can view the chart normally. Please give it a try.
Note: In the code, please change the "Chart 1" to your own chart name. And specify the email address in the To field.
Sub mailHTMLsend()
'Updated by Extendoffice 20221013
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xStartMsg As String
    Dim xEndMsg As String
    Dim xChartName 'As String
    Dim xChartPath As String
    Dim xPath As String
    Dim xChart As ChartObject
    On Error Resume Next
    xChartName = "Chart 1" 'The name of the chart in the current worksheet you want to send.
    If xChartName = "" Then Exit Sub
    Set xChart = Application.ActiveSheet.ChartObjects(xChartName)
    If xChart Is Nothing Then Exit Sub
    
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    
    xStartMsg = "<font size='5' color='black'> Good Day," & "<br> <br>" & "Please find the chart below: " & "<br> <br> </font>"
    xEndMsg = "<font size='4' color='black'> Many Thanks," & "<br> <br> </font>"
    xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".bmp"
    
    xPath = "<p align='Left'><img src="/%20&%20"cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """  width=700 height=500 > <br> <br>"
    
    xChart.Chart.Export xChartPath
    With xOutMail
        .To = "Email Address"
        .Subject = "Add Chart in outlook mail body"
        .Attachments.Add xChartPath
        .HTMLBody = xStartMsg & xPath & xEndMsg
        .Display
    End With
    Kill xChartPath
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
Reply
Report
0
0
crystal
crystal     Kuba
This comment was minimized by the moderator on the site
Hi Kuba,
Please remove the / tag in <img src="/.
The error is caused by the editor in the site.
Sorry for the inconvenience.
Reply
Report
0
0
Kuba
Kuba     crystal
This comment was minimized by the moderator on the site
cześć, pełny kod działa tylko do momentu podglądu komunikatu, przy wysyłce adresat otrzymuje błąd i wykresu nie widać ("Nie można wyświetlić połączonego obrazu. Plik mógł zostać przeniesiony lub usunięty albo zmieniono jego nazwę. Sprawdź czy łącze wskazuje poprawny plik i lokazlizację.") Czy z Was też tak ktoś miał czy tylko u mnie taki zonk? Prosze o pomoc, tutaj kod, który dotyczy wykresum już tak mało brakuje :)

Dim xChartName As String
Dim xChartPath As String
Dim xPath As String
Dim xChart As ChartObject
On Error Resume Next
Dim wydzialy As String
wydzialy = lista.Cells(3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , , , 2) 'Wykres1 '"Please enter the chart name:"
If xChartName = "" Then Exit Sub
Set xChart = Sheets("Wykresy").ChartObjects(xChartName) 'Change "Sheet1" to your worksheet name
If xChart Is Nothing Then Exit Sub
xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".svg" '.bmp '.svg '.svg ma lepsza jakość
xPath = "<p align='Left'><img src="/%20&%20"cid:" & Mid(xChartPath, InStrRev(xChartPath, "\") + 1) & """ width=500 height=300 > <br> <br>"
xChart.Chart.Export xChartPath


Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = emails(b)
.CC = emails_dw(b)
.Subject = "XXXX" ' - " & lista.Cells(i, 66)
.Attachments.Add xChartPath
.HTMLBody = "treść" & xPath

Set .SendUsingAccount = OutApp.Session.Accounts.Item(1)

.Display
End With
Kill xChartPath
Set OutMail = Nothing
Set OutApp = Nothing
0
0
Nitin Sharma
Nitin Sharma
This comment was minimized by the moderator on the site
There is error in the code : "\") + 1) & """ width=700 height=50In the bold text the middle one should be a single inverted comma

Reply
0
0
Aaron Manqueo
Aaron Manqueo
This comment was minimized by the moderator on the site
hola como puede enviar por correo, una tabla dinámica, y no un gráfico
Reply
0
0
leigh
leigh
This comment was minimized by the moderator on the site
when i enter the chart name the mail doesn't generate the dialog box just closes, any idea what i have done wrong? I have followed each step
Reply
0
0
Borges
Borges     leigh
This comment was minimized by the moderator on the site
The issue is that we can not set names for Chart Objects like tables. You need to pass the integer ID to work. For instance, if you only have 1 chart in the "Sheet1", trying passing the value 1 when the msgbox shows up.

PS: sorry for the bad english :]
Reply
0
0
There are no comments posted here yet
Please leave your comments in English
Guest
Posting as Guest
×
Rate this post:
Reset
0   Characters
Suggested Locations