Excel VBA - Zellbereich als Bild speicher / Code geht nur sporadisch

Sub als_Bild_speichern()

Dim objPict As Object
Dim objChrt As Chart
Dim rngImage As Range 'Größe des zu speichernden Bereichs'
Dim strFile As String

    Application.ScreenUpdating = False
    ActiveWindow.DisplayGridlines = False 'Gitternetz anzeigen'
    
    If MsgBox("Haben Sie alle notwendigen Anpassungen vorgenommen, sodass das Bild der Fehlerlandkarte nun" _
            & " erzeugt werden kann?", vbYesNo, "Bearbeitung abgeschlossen?") = vbNo Then
        MsgBox "Bild der Fehlerlandkarte wird nicht erzeugt." & vbNewLine & _
                "Bitte passen Sie zunächst die Fehlerlandkarte fertig an.", vbOKOnly, _
                "Bild nicht erzeugt"
        Exit Sub
    Else
        'Als JPEG abspeichern'
        On Error GoTo ErrExit
        With ActiveSheet
            Set rngImage = .Range("A1:K56") 'Bereich der für das Bild verwendet wird.'
            rngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
            .PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
            Set objPict = .Shapes(.Shapes.Count)
            strFile = "F:\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
        ActiveWindow.DisplayGridlines = True
        Application.ScreenUpdating = True
        MsgBox "Das Bild wurde erfolgreich unter: " & vbNewLine & strFile & vbNewLine & _
        "abgespeichert." & vbNewLine & _
                "Sie können nun das Bild in die globale Fehlerlandkarte einpflegen.", vbOKOnly, _
                "Bild erfolgreicht gespeichert"
    End If
    Exit Sub
    
    
  
ErrExit:
    Set objPict = Nothing
    Set objChrt = Nothing
    Set rngImage = Nothing
    
    ActiveWindow.DisplayGridlines = True
    Application.ScreenUpdating = True
    MsgBox "Ein kritischer Systemfehler ist aufgetreten, weshalb das Bild nicht gespeichert werden kann." & vbNewLine & _
            "Bitte wenden Sie sich an den Programmierer dieses Tools.", vbOKOnly, "Systemfehler vorhanden"

End Sub

Option Explicit

Sub Range_To_Image()
  Dim objPict As Object, objChrt As Chart
  Dim rngImage As Range, strFile As String
  
  On Error GoTo ErrExit
  
  With Sheets("Tabelle1") 'Tabellenname - Anpassen!'
    
    Set rngImage = .Range("A1:C20")
    
    rngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
    
    .PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
    
    Set objPict = .Shapes(.Shapes.Count)
    
    strFile = "E:\Temp\meinBild.gif" '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