Макрос Excel VBA: вставить диапазон (таблицу) как изображение в текст письма

💼 Наймите меня для автоматизации Excel VBA
Нужна помощь в автоматизации рабочих процессов Excel? Я специализируюсь на разработке индивидуальных решений для Excel VBA, которые сэкономят ваше время и избавят от повторяющихся задач.
👉 https://www.upwork.com/freelancers/~0...

Макрос Excel VBA: вставить диапазон (таблицу) как изображение в тело письма. В этом видео мы рассмотрим, как автоматически отправлять электронное письмо с таблицей в качестве изображения. Мы выбираем диапазон ячеек для создания таблицы, копируем и вставляем диапазон как изображение, вырезаем и вставляем это изображение в тело письма.

Код (YouTube не поддерживает скобки, поэтому LT и GT используются для «меньше» и «больше» соответственно):

Sub send_email_with_table_as_pic()

Dim OutApp As Object
Dim OutMail As Object
Dim table As Range
Dim pic As Picture
Dim ws As Worksheet
Dim wordDoc

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

'захватить таблицу, преобразовать в изображение и вырезать
Set ws = ThisWorkbook.Sheets("Population Data")
Set table = ws.Range("A1:C9")
ws.Activate
table.Copy
Set pic = ws.Pictures.Paste
pic.Cut

'создать сообщение электронной почты
При ошибке продолжить
С OutMail
.to = "team@abc.com"
.CC = ""
.BCC = ""
.Subject = "Данные о населении страны" & Format(Date, "mm-dd-yy")
.Display

Set wordDoc = OutMail.GetInspector.WordEditor
With wordDoc.Range
.PasteandFormat wdChartPicture
.insertParagraphAfter
.insertParagraphAfter
.InsertAfter "Спасибо,"
.insertParagraphAfter
.InsertAfter "Грег"
Завершить с помощью

.HTMLBody = "LT BODY style = font-size:11pt; font-family:Calibri GT" & _
"Привет, команда LTpGT. См. таблицу ниже: LTpGT" & .HTMLBody
Завершить с помощью
При ошибке GoTo 0

Set OutApp = Nothing
Set OutMail = Ничего

Конец субтитров

Данные, использованные в этом видео:
https://gsociology.icaap.org/datauplo...

#ExcelVBA #ExcelMacro