Bereich als Bild speichern

Sub Range_To_Image()
Dim objPict As Object, objChrt As Chart
Dim rngImage As Range, strFile As String
On Error GoTo ErrExit
With Sheets("Backup Floorwalk") 'Tabellenname - Anpassen!
Set rngImage = .Range("A1:N33")
rngImage.CopyPicture Appearance:=xlScreen, Format:=xlPicture
.PasteSpecial Format:="Picture", Link:=False, DisplayAsIcon:=False
Set objPict = .Shapes(.Shapes.Count)
strFile = Sheets("Einstellungen").Range("B2") & "TEST.jpg" 'Pfad und Dateiname für das Bild
objPict.Copy
Set objChrt = .ChartObjects.Add(1, 1, 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