Перейти к основному содержанию

Как отправить конкретную диаграмму по электронной почте с помощью vba в Excel?

Возможно, вы знаете, как отправить электронное письмо через 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

Внимание: В коде измените адрес электронной почты получателя и тему электронной почты в строке .К = "" и линии .Subject = "Добавить диаграмму в текст сообщения Outlook" , Sheet1 - это лист, содержащий диаграмму, которую вы хотите отправить, замените ее на свою.

3. нажмите F5 ключ для запуска кода. В открытии Kutools for Excel в диалоговом окне введите имя диаграммы, которую вы прикрепите к тексту сообщения электронной почты, а затем щелкните значок OK кнопка. Смотрите скриншот:

Затем автоматически создается электронное письмо с указанной диаграммой, отображаемой в теле письма, как показано на скриншоте ниже. Пожалуйста, нажмите кнопку «Отправить», чтобы отправить это письмо.


Статьи по теме:

 

 

 

Лучшие инструменты для офисной работы

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

Улучшите свои навыки работы с Excel с помощью Kutools for Excel и почувствуйте эффективность, как никогда раньше. Kutools for Excel предлагает более 300 расширенных функций для повышения производительности и экономии времени.  Нажмите здесь, чтобы получить функцию, которая вам нужна больше всего...

Описание


Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 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