Sub Screenshots()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("Overview Übersicht 7 Tage - (2)")
Dim rng As Range
Set rng = ws.Range("B3:T71")
Workbooks.Add
Dim CH As Chart
Set CH = Charts.Add
CH.Location xlLocationAsObject, "Tabelle1"
Set CH = ActiveChart
ActiveChart.Parent.Name = "rschwenk"
ActiveSheet.ChartObjects("rschwenk").Height = rng.Height
ActiveSheet.ChartObjects("rschwenk").Width = rng.Width
rng.CopyPicture xlScreen, xlBitmap
CH.Paste
CH.Export "C:\Users\rschwenk\Desktop\Ausbildung\Screenshot5.png"
Dim oApp As Object
Set oApp = CreateObject("Outlook.Application")
On Error Resume Next
With oApp.CreateItem(0)
Application.Wait 1
.To = "rschwenk@united-internet.de"
.Subject = "Betreff"
.HTMLBody = "<img src= 'C:\Users\rschwenk\Desktop\Ausbildung\Screenshot1.png'>" & "<img src= 'C:\Users\rschwenk\Desktop\Ausbildung\Screenshot2.png'>" & "<img src= 'C:\Users\rschwenk\Desktop\Ausbildung\Screenshot3.png'>" & "<img src= 'C:\Users\rschwenk\Desktop\Ausbildung\Screenshot4.png'>" & "<img src= 'C:\Users\rschwenk\Desktop\Ausbildung\Screenshot5.png'>"
.Display
SendKeys "{END}", True
SendKeys "~", True
SendKeys "^v", True
SendKeys "~", True
.GetInspector
End With
On Error GoTo 0
Set oApp = Nothing
End Sub
Die Lösung über "img src" würde ich nach Möglichkeit auch gerne mit einer Bitmap-Alternativ umgehen.
Vorab schon einmal vielen Dank für eure Unterstützung und beste Grüße