Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Добавление диаграммы в письмо - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, Manyasha, SLAVICK, китин  
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Outlook » Добавление диаграммы в письмо
Добавление диаграммы в письмо
Oh_Nick Дата: Среда, 06.10.2021, 11:00 | Сообщение № 1
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 225
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Всем доброго времени суток!

Нашел на просторах интернета код , который добавляет диаграмму в письмо. Нюанс: диаграмма добавляется только при выделении. Можно ли сделать, чтобы она добавлялась без выделения?

[vba]
Код
Sub SendMail_WithChartAsPicture()
Dim objOutlookApp As Object, objMail As Object
Dim oChart As Chart
Dim sChartPath As String, sPictureBodyCode As String

Application.ScreenUpdating = False
'копируем выделенную диаграмму
On Error Resume Next
Set oChart = ActiveChart
If oChart Is Nothing Then
MsgBox "Необходимо выделить диаграмму"
Exit Sub
End If
'путь для сохранения диаграммы на диске(необходим для дальнейшей вставки в письмо)
sChartPath = ThisWorkbook.Path & "\chart.png"
'сохраняем диаграмму как картинку PNG на диск
oChart.Export sChartPath, "PNG"
'создаем код для вставки диаграммы в письмо
sPictureBodyCode = "<img src=cid:" & Replace(Dir(sChartPath, 16), " ", "%20") & ">" ' & " height=240 width=180>"
'" height=240 width=180>" - если нужны конкретные размеры вставляемой картинки

'пробуем подключиться к Outlook
Set objOutlookApp = CreateObject("Outlook.Application")
'создаем новое сообщение
Set objMail = objOutlookApp.CreateItem(0)
'при подключении к Outlook или при создании письма произошла ошибка
'завершаем работу кода
If Err.Number <> 0 Then
Set objOutlookApp = Nothing
Set objMail = Nothing
Exit Sub
End If
On Error GoTo 0
'задаем параметры созданного сообщения
With objMail
.To = "адрес получателя"
.Subject = "Тема: вставка в письмо диаграммы"
.BodyFormat = 2 'olFormatHTML - формат HTML
.Attachments.Add sChartPath
.Display 'отображаем сообщение
'передаем управление ОС, чтобы завершились все лишние процессы
DoEvents
'теперь добавляем диаграмму
.HTMLBody = sPictureBodyCode & "<p>" & .HTMLBody
'.Send 'если надо сразу отправить письмо
End With
'удаляем временную картинку диаграммы с диска
Kill sChartPath
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub
[/vba]
 
Ответить
СообщениеВсем доброго времени суток!

Нашел на просторах интернета код , который добавляет диаграмму в письмо. Нюанс: диаграмма добавляется только при выделении. Можно ли сделать, чтобы она добавлялась без выделения?

[vba]
Код
Sub SendMail_WithChartAsPicture()
Dim objOutlookApp As Object, objMail As Object
Dim oChart As Chart
Dim sChartPath As String, sPictureBodyCode As String

Application.ScreenUpdating = False
'копируем выделенную диаграмму
On Error Resume Next
Set oChart = ActiveChart
If oChart Is Nothing Then
MsgBox "Необходимо выделить диаграмму"
Exit Sub
End If
'путь для сохранения диаграммы на диске(необходим для дальнейшей вставки в письмо)
sChartPath = ThisWorkbook.Path & "\chart.png"
'сохраняем диаграмму как картинку PNG на диск
oChart.Export sChartPath, "PNG"
'создаем код для вставки диаграммы в письмо
sPictureBodyCode = "<img src=cid:" & Replace(Dir(sChartPath, 16), " ", "%20") & ">" ' & " height=240 width=180>"
'" height=240 width=180>" - если нужны конкретные размеры вставляемой картинки

'пробуем подключиться к Outlook
Set objOutlookApp = CreateObject("Outlook.Application")
'создаем новое сообщение
Set objMail = objOutlookApp.CreateItem(0)
'при подключении к Outlook или при создании письма произошла ошибка
'завершаем работу кода
If Err.Number <> 0 Then
Set objOutlookApp = Nothing
Set objMail = Nothing
Exit Sub
End If
On Error GoTo 0
'задаем параметры созданного сообщения
With objMail
.To = "адрес получателя"
.Subject = "Тема: вставка в письмо диаграммы"
.BodyFormat = 2 'olFormatHTML - формат HTML
.Attachments.Add sChartPath
.Display 'отображаем сообщение
'передаем управление ОС, чтобы завершились все лишние процессы
DoEvents
'теперь добавляем диаграмму
.HTMLBody = sPictureBodyCode & "<p>" & .HTMLBody
'.Send 'если надо сразу отправить письмо
End With
'удаляем временную картинку диаграммы с диска
Kill sChartPath
Set objOutlookApp = Nothing: Set objMail = Nothing
Application.ScreenUpdating = True
End Sub
[/vba]

Автор - Oh_Nick
Дата добавления - 06.10.2021 в 11:00
Oh_Nick Дата: Среда, 06.10.2021, 13:24 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 225
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Сделал сам. Можно закрыть тему.
 
Ответить
СообщениеСделал сам. Можно закрыть тему.

Автор - Oh_Nick
Дата добавления - 06.10.2021 в 13:24
Мир MS Excel » Вопросы и решения » Excel и другие приложения » Outlook » Добавление диаграммы в письмо
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования Jobsora jooble
© 2010-2021 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!