Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Grafik in Excel mit VBA abspeichern
#1
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 dankbarSmile


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
Antwortento top
#2
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
Antwortento top
#3
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
Antwortento top
#4
https://berndplumhoff.gitbook.io/sulprob...ge2picture
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste