Diagramm hochauflösend kopieren
#1
Hallo!
Ich habe ein Diagramm welches ich mehr oder weniger hochauflösend als Bild kopieren und in einer anderen Zelle einfügen möchte. 
Über den normalen kopier Vorgang wird die Qualität eines Excel Diagramms ja immer etwas sehr unscharf.

Nun gibt es ja die Möglichkeit das Diagramm "Als Bild kopieren / wie ausgedruckt" deutlich schärfer darzustellen.

Gibt es eine Möglichkeit diesen Befehl über VBA auszudrücken? Der Makro Aufzeichner hat mir leider nicht weitergeholfen.


Vielen Dank und Gruß!
Top
#2
Hallöchen,

mit etwas experimentieren hilft auch aufzeichnen. Beim Diagramm direkt wird nicht alles mitgeschnitten, aber wenn man Zellen nimmt …
Schaue mal das an:

Zitat:Sub Makro2()
'
' Makro2 Makro
'

'
Range("A18:C21").Select
Selection.CopyPicture Appearance:=xlScreen, Format:=xlBitmap
Range("E18").Select
ActiveSheet.Paste
End Sub
Sub Makro3()
'
' Makro3 Makro
'

'
ActiveSheet.ChartObjects("Diagramm 2").Activate
ActiveChart.ChartTitle.Select
Range("J15").Select
ActiveSheet.Paste
End Sub


Passend umgesetz wird eine Zeile Code zum Kopieren draus

ActiveSheet.ChartObjects("Diagramm 2").CopyPicture Appearance:=xlScreen, Format:=xlBitmap

und dann noch irgendwo einfügen...
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • diving_excel
Top
#3
Hallo

Oder auch als PNG
Dieser Code erstellt einen Ordner im Pfad deiner Datei und fügt das Bild mit dem Titelname des Diagramms ein.
Der einfache Weg ist nur die Zoomgrösse, die du im Code anpassen kannst (Max 400).

Code:
Sub DiagrammAlsPNG()
Dim Pfad As String, BildGr As Integer, sFName As String, xName As String
    BildGr = ActiveWindow.Zoom
        ActiveWindow.Zoom = 300                             'Beliebig anpassen
       
    Pfad = ThisWorkbook.Path & "\Diagramme\"
        If Dir(Pfad, vbDirectory) = "" Then MkDir Pfad
           
        ActiveSheet.ChartObjects("Diagramm 3").Activate     'Diagramm anpassen
       
    xName = ActiveChart.ChartTitle.Text
        Selection.Chart.Export Pfad & xName & ".png"
       
    ActiveWindow.Zoom = BildGr
End Sub
Gruss Guschti
Der Künstler lebt auch vom Applaus
Excel Optimaler Zuschnitt von Stangen/Balken - YouTube
[-] Folgende(r) 1 Nutzer sagt Danke an Guschti für diesen Beitrag:
  • diving_excel
Top
#4
Hi Guschti,

jetzt fehlt noch das Einfügen des exportierten Bildes in eine Zelle Smile
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
[-] Folgende(r) 1 Nutzer sagt Danke an schauan für diesen Beitrag:
  • diving_excel
Top
#5
Vielen Dank! Ich dachte gerade beim Makroaufzeichner müsste ich die Diagramme direkt anklicken. Wieder was gelernt!

Viele Grüße!
Top
#6
Hallöchen,

also, wie gesagt, für den Code hab ich mal den Bereich gewählt (Makro2) und mit einer zweiten Aufzeichnung das Diagramm (Makro3)

aus dem Makro3 hab ich dann die genaue Syntax für das Diagramm
ActiveSheet.ChartObjects("Diagramm 2")

und dahinter aus Makro2 das Kopieren
.CopyPicture Appearance:=xlScreen, Format:=xlBitmap

Excel zeichnet manche Aktionen bei Objekten nicht auf.
Wenn Du beim Diagramm z.B. eine Säule anders färbst, den Code bekommst Du. Oder wenn Du ein anderes Objekt kopierst und in das Diagramm einfügst, den Code bekommst Du auch. Nur eben z.B. das Kopieren als Bild nicht Sad Geht auch nicht, wenn Du ein anderes Objekt so kopieren willst, z.B. eine TextBox oder was auch immer Sad .
Manchmal hilft dann, wie hier, ein kleiner Umweg Smile
.      \\\|///      Hoffe, geholfen zu haben.
       ( ô ô )      Grüße, André aus G in T  
  ooO-(_)-Ooo    (Excel 97-2019+365)
Top


Gehe zu:


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