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