Note: The other languages of the website are Google-translated. Back to English

Как отправить конкретную диаграмму по электронной почте с помощью 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 = "xrr@163.com"
        .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 = "xrr@163.com" и линии .Subject = "Добавить диаграмму в текст сообщения Outlook" , Sheet1 - это лист, содержащий диаграмму, которую вы хотите отправить, замените ее на свою.

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

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


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

 

 

 


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

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

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

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно

 

 

Сортировать комментарии по
Комментарии (13)
Оценок пока нет. Оцените первым!
Этот комментарий был сведен к минимуму модератором на сайте
когда я ввожу имя диаграммы, почта не генерируется, диалоговое окно просто закрывается, есть идеи, что я сделал неправильно? Я следил за каждым шагом
Этот комментарий был сведен к минимуму модератором на сайте
Проблема в том, что мы не можем устанавливать имена для объектов диаграммы, таких как таблицы. Вам нужно передать целочисленный идентификатор для работы. Например, если у вас есть только 1 диаграмма на «Листе1», попробуйте передать значение 1, когда появится окно msgbox.

PS: извините за плохой английский:]
Этот комментарий был сведен к минимуму модератором на сайте
Hola como puede enviar por correo, una tabla dinámica, y no un grafico
Этот комментарий был сведен к минимуму модератором на сайте
В коде ошибка: "\") + 1) & «»» width=700 height=50В полужирном тексте посередине должна стоять одна кавычка

Этот комментарий был сведен к минимуму модератором на сайте
Он включает в себя диаграмму в качестве приложения. Есть ли у вас какие-либо идеи, как включить его в качестве изображения в самом теле письма. Спасибо, Юссеф.
Этот комментарий был сведен к минимуму модератором на сайте
Та же проблема, есть решение?
Этот комментарий был сведен к минимуму модератором на сайте
Привет Джей,
Код обновлен. Пожалуйста, попробуйте. Извините за беспокойство.


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 = "xrr@163.com"
        .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
Этот комментарий был сведен к минимуму модератором на сайте
Привет,
mi nic sie nie załącza, czy coś tutaj należałoby wpisać jeszcze?
xPath = "co tutaj trzeba wprowadzić?"
Этот комментарий был сведен к минимуму модератором на сайте
Привет Куба,
Пожалуйста, удалите / пометить в <img src="/.
Ошибка вызвана редактором на сайте.
Извините за причиненные неудобства.
Этот комментарий был сведен к минимуму модератором на сайте
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ś mial czy tylko u mnie taki zonk? Prosze o pomoc, tutaj kod, który dotyczy wykresum już tak mało brakuje :)

Dim xChartName как строка
Dim xChartPath как строка
Dim xPath как строка
Dim xChart как ChartObject
On Error Resume Next
Dim wydzialy As String
wydzialy = lista.Cells(3, 75)
xChartName = Application.InputBox(wydzialy, "KuTools for Excel", , , , , , 2) 'Wykres1 '"Введите имя диаграммы:"
Если xChartName = "", то выйдите из подпрограммы
Установите xChart = Sheets("Wykresy").ChartObjects(xChartName) 'Замените "Sheet1" на имя вашего рабочего листа
Если xChart ничего не значит, выйдите из Sub
xChartPath = Application.ActiveWorkbook.Path & "\" & Environ("USERNAME") & VBA.Format(VBA.Now(), "DD_MM_YY_HH_MM_SS") & ".svg" '.bmp '.svg '.svg ma lepsza jakość
хПуть = " "
xChart.Chart.Export


Dim OutApp как объект
Затемнить OutMail как объект
Установите OutApp = CreateObject("Outlook.Application")
Установить OutMail = OutApp.CreateItem(0)
С OutMail
.To = электронная почта (b)
.CC = emails_dw(b)
.Subject = "XXXX" ' - " & lista.Cells(i, 66)
.Attachments.Добавить xChartPath
.HTMLBody = "трещина" и xPath

Установите .SendUsingAccount = OutApp.Session.Accounts.Item(1)

.Отображать
Конец с
Убить xChartPath
Установите OutMail = Ничего
Установить OutApp = Ничего
Этот комментарий был сведен к минимуму модератором на сайте
Привет Куба,
Код обновлен. Получатель может просматривать диаграмму в обычном режиме. Пожалуйста, попробуйте.
Внимание: В коде измените "Диаграмма 1" на собственное имя диаграммы. И укажите адрес электронной почты в поле Кому.
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
Этот комментарий был сведен к минимуму модератором на сайте
ПРИВЕТ, я хочу добавить место в теле письма, какое ключевое слово я должен использовать.
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Паван Чугул,
Следующие две строки в коде содержат содержимое тела письма. Вы можете вручную изменить текст сообщения электронной почты, нажав клавишу пробела на клавиатуре, чтобы добавить пробел.
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>"
Здесь еще нет комментариев
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL