Pivottabelle zeilenweise als Bild exportieren

Sub exportiereAlleAlsBild()

    Dim objPict As Object, objChrt As Chart

    Dim rngImage As Range, strFile As String

    Dim arbeitsmappe As Workbook

    Dim zeilen As Long

    Set arbeitsmappe = ActiveWorkbook

    On Error GoTo ErrExit

    

    With arbeitsmappe.Worksheets("Daten")

        zeilen = .PivotTables(1).TableRange2.Rows.Count

        Set rngImage = .Range("A1:Z45")

        rngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

        .PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False

        Set objPict = .Shapes(.Shapes.Count)

        strFile = "C:\Users\Dennis\Downloads\" & "TEST.jpg"

        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