Прескочи на основното съдържание

Как да изпратите конкретна диаграма в имейл с vba в Excel?

Автор: Силувия Последна промяна: 2022-07-29

Може да знаете как да изпратите имейл през Outlook в Excel с VBA код. Но знаете ли как да прикачите конкретна диаграма в определен работен лист към тялото на имейла? Тази статия ще ви покаже метода за решаване на този проблем.

Изпратете конкретна диаграма в имейл в Excel с VBA код


Изпратете конкретна диаграма в имейл в Excel с VBA код

Моля, направете следното, за да изпратите конкретна диаграма в имейл с VBA код в Excel.

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 за Excel диалоговия прозорец, въведете името на диаграмата, която ще прикачите в тялото на имейла, и след това щракнете върху OK бутон. Вижте екранна снимка:

След това имейл се създава автоматично с указаната диаграма, показваща се в тялото на имейла, както е показано на екранната снимка по-долу. Моля, щракнете върху бутона Изпрати, за да изпратите този имейл.


Още по темата:

 

 

 

Най-добрите инструменти за продуктивност в офиса

🤖 Kutools AI помощник: Революционизирайте анализа на данни въз основа на: Интелигентно изпълнение   |  Генериране на код  |  Създаване на персонализирани формули  |  Анализирайте данни и генерирайте диаграми  |  Извикване на функциите на Kutools...
Популярни функции: Намерете, маркирайте или идентифицирайте дубликати   |  Изтриване на празни редове   |  Комбинирайте колони или клетки без загуба на данни   |   Кръг без формула ...
Супер търсене: VLookup с множество критерии    VLookup с множество стойности  |   VLookup в няколко листа   |   Размито търсене ....
Разширен падащ списък: Бързо създаване на падащ списък   |  Зависим падащ списък   |  Падащ списък с множество избори ....
Мениджър на колони: Добавете конкретен брой колони  |  Преместване на колони  |  Превключване на състоянието на видимост на скритите колони  |  Сравнете диапазони и колони ...
Препоръчани функции: Мрежов фокус   |  Изглед на дизайна   |   Голям формула бар    Мениджър на работни книги и листове   |  Библиотека с ресурси (Автоматичен текст)   |  Избор на дата   |  Комбинирайте работни листове   |  Шифроване/декриптиране на клетки    Изпращайте имейли по списък   |  Супер филтър   |   Специален филтър (филтър получер/курсив/зачертано...) ...
Топ 15 комплекта инструменти12 Текст Инструменти (добавяне на текст, Премахване на символи, ...)   |   50 + Графика Видове (диаграма на Гант, ...)   |   40+ Практичен формули (Изчислете възрастта въз основа на рождения ден, ...)   |   19 вмъкване Инструменти (Въведете QR код, Вмъкване на картина от пътя, ...)   |   12 Конверсия Инструменти (Числа към думи, Валутен обмен, ...)   |   7 Обединяване и разделяне Инструменти (Разширено комбиниране на редове, Разделени клетки, ...)   |   ... и още

Усъвършенствайте уменията си за Excel с Kutools за Excel и изпитайте ефективност, както никога досега. Kutools за Excel предлага над 300 разширени функции за повишаване на производителността и спестяване на време.  Щракнете тук, за да получите функцията, от която се нуждаете най-много...

Описание


Раздел Office Внася интерфейс с раздели в Office и прави работата ви много по-лесна

  • Разрешете редактиране и четене с раздели в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
  • Отваряйте и създавайте множество документи в нови раздели на един и същ прозорец, а не в нови прозорци.
  • Увеличава вашата производителност с 50% и намалява стотици кликвания на мишката за вас всеки ден!

 

 

Comments (15)
No ratings yet. Be the first to rate!
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.
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.
This comment was minimized by the moderator on the site
HELLO , I want to add space in mail body , which keyword should I use.
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>"
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
This comment was minimized by the moderator on the site
Same problem, any solution?
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
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ć?"
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
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.
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
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

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
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
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 :]
There are no comments posted here yet
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations