VBA - Bereich als Grafik unter Pfad speichern

[Boduaka]

Hallo liebes Forum,

ich habe ein kleines Problem und benötige Hilfe beim VBA-Code.

Grundsätzlich funktioniert mein Code und eine Bilddatei wird gespeichert.
Das Problem besteht darin, dass das Bild nur weiß ist und die eigentliche
Range aus der Tabelle nicht zu sehen ist. Was muss ich ändern?

Vielen Dank.

Code:

Public Sub Range_To_Image_save()

   Const EXPORT_PATH = "C:\User\Test.jpg"

   Dim objChrt As Chart
   Dim rngImage As Range

   Application.ScreenUpdating = False

   With Sheets("Tabelle2")
       
       Set rngImage = .Range("A36:AF103")
       On Error Resume Next
       Do
           rngImage.CopyPicture Appearance:=xlScreen, Format:=xlPicture
       Loop Until Err.Number = 0
       On Error GoTo 0
       Set objChrt = .ChartObjects.Add(1, 1, rngImage.Width, rngImage.Height).Chart
       objChrt.Paste
       objChrt.Export EXPORT_PATH
       objChrt.Parent.Delete
       
   End With

   Set objChrt = Nothing
   Set rngImage = Nothing

End Sub

P.S.: bin VBA Anfänger :30:

[MisterBurns]

Tu mal lieber so:

Code:

Public Sub Screenshot_abspeichern()
   Dim objChartObject As ChartObject
   Application.ScreenUpdating = False
   Worksheets("Tabelle2").Range("A36:AF103").CopyPicture Appearance:=xlScreen, Format:=xlPicture
   Set objChartObject = ActiveSheet.ChartObjects.Add(0, 0, Range("A36:AF103").Width, Range("A36:AF103").Height)
   With objChartObject
       .Activate
       With .Chart
           .Paste
           .Export "C:\User\Text.jpg", "JPG"
       End With
       .Delete
   End With
   Application.ScreenUpdating = True
End Sub

[Boduaka]

Mega läuft super. Ganz lieben Dank. :74: