Zellenbereich als Grafik in E-mail einfügen

Sub Preisalarm()
Const BETREFF$ = "Preisalarm!" 'Betreff
Const ANREDEM$ = "Sehr geehrter Herr " 'Anrede Mann
Const ANREDEF$ = "Sehr geehrte Frau " 'Anrede Frau
Const MAILTEXT$ = "Das ist ein Standardtext für den Preisalarm!" 'Mailtext
Const SCHLUSS$ = "Mit freundlichen Grüßen" & vbCrLf & vbCrLf & "Ihr Preiswecker!" 'Gruß _
formel
Dim Wb As Workbook: Set Wb = ThisWorkbook
Dim Ws As Worksheet: Set Ws = Wb.Worksheets("Tabelle1")
Dim Liste As Range, Eintrag As Range
Dim Ol As Object
On Error Resume Next
Set Ol = GetObject(, "Outlook.Application") 'Outlook öffnen
If Err Then Set Ol = CreateObject("Outlook.Application")
Set Liste = Ws.Range("A5:A" & Ws.Cells(Ws.Rows.Count, 1).End(xlUp).Row) 'Geht Tabelle ab A5  _
runter
For Each Eintrag In Liste
With Eintrag
If .Offset(, 3).Value = .Offset(, 5).Value Then 'Wenn D=F, dann
With Ol.CreateItem(0)
.Subject = BETREFF
.To = Eintrag.Offset(, 6).Value 'an E-mail in G
.Body = IIf(Eintrag.Offset(, 7) = "Herr", ANREDEM, ANREDEF) & _
Eintrag.Offset(, 8).Value & "," & vbLf & vbLf & _
MAILTEXT & vbLf & vbLf & _
"GP: " & Eintrag.Offset(, 1) & "|TP: " & Eintrag.Offset(, 3) & _
"|Min: " & Eintrag.Offset(, 4) & "|Max: " & Eintrag.Offset(, 5) & _
vbLf & vbLf & _
SCHLUSS '& Eintrag.Value --> Eintrag aus A
.Display 'Mail anzeigen, manuell senden
End With
End If
End With
Next Eintrag
End Sub