Sub Grafik_speichern()
Dim objPict As Object, objChrt As Chart
Dim rngImage As Range, strFile As String
On Error GoTo ErrExit
With Sheets("Tabelle1")
Set rngImage = .Range("J15:N27")
rngImage.CopyPicture Appearance:=xlScreen, Format:=xlPicture
.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
Set objPict = .Shapes(.Shapes.Count)
strFile = "Speicherpfad" & Range("L9") & ".png"
objPict.Copy
Set objChrt = .ChartObjects.Add(0, 0, objPict.Width + 8, objPict.Height + 8).Chart
objChrt.Paste
objChrt.Export strFile
objChrt.Parent.Delete
objPict.Delete
End With
ErrExit:
Set objPict = Nothing
Set objChrt = Nothing
Set rngImage = Nothing
End Sub