Grafik in Excel mit VBA abspeichern

[ueberallm23]

Hallo zusammen,

ich habe folgendes Problem.

Ich möchte mit einem VBA-Code, eine in Excel erstellte Grafik auf meinen PC-abspeichern. Den Code den ich benutze, funktioniert aber nur wenn ich in Visual Basic den Code händisch mit F8 durchgehe. Falls ich das Makro in Excel benutze, wird nur ein leeres Bild abgespeichert. 

Hatte jemand schon das selbe Problem?


Für jede Hilfe wäre ich sehr dankbar :)


Viele Grüße
Max

Code:

Sub Grafik_1_speichern()
  Dim objPict As Object, objChrt As Chart
  Dim rngImage As Range, strFile As String
 
 
On Error GoTo ErrExit
 
  With Sheets("Auswertung") 'Tabellenname - Anpassen!
   
    Set rngImage = .Range("B5:R51")
   
    rngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
   
   
   
    .PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
   
    Set objPict = .Shapes(.Shapes.Count)
   
    strFile = "C:\Users\maxim\Documents\Arbeit\IAV\Auswertung\meinBild.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

[volti]

Hallo Max,

das Problem mit dem unzuverlässigen Kopieren ist bekannt.

Ich mache es deshalb so:

Zur Sicherheit könnte man ggf. noch einen Hochzähler für's Rausspringen dazunehmen.

On Error Resume Next
   Do
     rngImage.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
     If Err.Number = 0 Then Exit Do
     Err.Clear
   Loop

viele Grüße aus Freigericht
Karl-Heinz

[ueberallm23]

Hallo Karl-Heinz

vielen Dank für deine schnelle Antwort.

Leider funktioniert das so bei mir nicht, ich hab dann das gleiche Problem wie oben beschrieben.

Gibt es noch eine andere Möglichkeit?


Vielen Dank und Grüße

Max

[Sulprobil]

https://berndplumhoff.gitbook.io/sulprob...ge2picture