Microsoft Excel

Herbers Excel/VBA-Archiv

[VBA] Diagramme als Bild speichern geht nicht mehr


Betrifft: [VBA] Diagramme als Bild speichern geht nicht mehr von: Nils
Geschrieben am: 04.12.2017 16:35:57

Hallo liebe Excel-VBA-Experten,

folgender Code funktioniert mit Excel 2007 wunderbar und nach einem Office-Update auf Excel 2010 nicht mehr. Ich bin gerade ein wenig am verzweifeln.

An der Stelle ObjektDiagramm.Paste schaltet sich der Debugger ein:
Laufzeitfehler '1004':
Die Methode 'Paste' für das Objekt '_Chart' ist fehlgeschlagen

Ich glaube es hat was mit dem Ansprechen des Diagramms zu tun. Wenn ich das Makro an der Stelle anhalte und die erzeugte Zwischenablage von Hand einfüge, geht es

Ich hoffe jemand weiß wieso Excel 2010 rumzickt...

Vielen Dank für jede Hilfe

Nils

Public RngDiagramme(0 To 2) As Variant, TxtDiagramme(0 To 2) As Variant

RngDiagramme(0) = Array("B108", "AN127", "B131", "AN150", "B154", "AN173", "B176", "AN195", " _
B199", "AN218", "B222", "AN241")
RngDiagramme(1) = Array("B118", "AN137", "B141", "AN160", "B163", "AN182", "B186", "AN205", " _
B208", "AN227", "B231", "AN250", "B253", "AN272", "B276", "AN295")
RngDiagramme(2) = Array("A1", "A5")

TxtDiagramme(0) = Array("HLTT_1_zeit", "HLTT_2_winkel", "HLTT_3_motor", "mLD_1_zeit", " _
mLD_2_winkel", "mLD_3_motor")
TxtDiagramme(1) = Array("HLTT_1_zeit", "HLTT_2_geschwindigkeit", "HLTT_3_hub", " _
HLTT_4_widerstand", "mLD_1_zeit", "mLD_2_geschwindigkeit", "mLD_3_hub", "mLD_4_widerstand")
TxtDiagramme(2) = Array("Test")


For j = a To b
    ' Nächsten Bereich festelegen
    Set Bereich = Range(RngDiagramme(i - 1)(2 * j - 2), RngDiagramme(i - 1)(2 * j - 1))
    ' Bereich als Bild kopieren
    Bereich.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
    ' Bereich als Bild einfügen
    ActiveSheet.Cells(Bereich.Row, Bereich.Column).Select
    ActiveSheet.PasteSpecial Format:="Bitmap", Link:=False, DisplayAsIcon:=False
    ' Bild umbenennen und kopieren
    Selection.Name = TxtDiagramme(i - 1)(j - 1)
    Set BildDiagramm = ActiveSheet.Shapes(TxtDiagramme(i - 1)(j - 1))
    BildDiagramm.Copy
    ' Diagramm einfügen
    Set ObjektDiagramm = ActiveSheet.ChartObjects.Add(Bereich.Left, Bereich.Top, BildDiagramm. _
Width, BildDiagramm.Height).Chart
    NummerDiagramm = ActiveSheet.ChartObjects.Count
    Set ObjektDiagramm = ActiveSheet.ChartObjects(NummerDiagramm).Chart
    ObjektDiagramm.ChartArea.Border.LineStyle = xlNone
    ' Bild in Diagramm einfügen
    ObjektDiagramm.Paste
    ' Bild exportieren
    PfadBild = OrdnerKurven & TxtDiagramme(i - 1)(j - 1) & ".jpg"
    ObjektDiagramm.Export PfadBild
    ' Objekte löschen
    ObjektDiagramm.Parent.Delete
    BildDiagramm.Delete
Next

  

Betrifft: AW: [VBA] Diagramme als Bild speichern geht nicht mehr von: Nepumuk
Geschrieben am: 04.12.2017 19:08:40

Hallo,

ich hab dein Programm etwas aufgeräumt. Teste mal:

For j = a To b
    
    Set Bereich = Range(RngDiagramme(i - 1)(2 * j - 2), RngDiagramme(i - 1)(2 * j - 1))
    
    Bereich.CopyPicture Appearance:=xlPrinter, Format:=xlPicture
    
    PfadBild = OrdnerKurven & TxtDiagramme(i - 1)(j - 1) & ".jpg"
    
    With Bereich
        Set ObjektDiagramm = ActiveSheet.ChartObjects.Add(.Left, .Top, .Width, .Height).Chart
    End With
    
    With ObjektDiagramm
        .Parent.Activate
        .Paste
        .Export PfadBild, "JPG"
        .Parent.Delete
    End With
Next

Gruß
Nepumuk


  

Betrifft: AW: [VBA] Diagramme als Bild speichern geht nicht mehr von: Nils
Geschrieben am: 05.12.2017 09:47:37

Vielen Dank Nepumuk,

Ich werde das mal heute Testen!
Ich hoffe es geht, größte Hoffnung setze ich auf die Zeile parent.activate, das klingt vielversprechend.
Ich melde mich sobald ich es ausprobieren konnte!

Danke
Nils


  

Betrifft: AW: [VBA] Diagramme als Bild speichern geht nicht mehr von: Nils
Geschrieben am: 07.12.2017 14:23:28

Danke Nepumuk!
Das klappt jetzt unter Excel 2007 und Excel 2010!

habe nur noch den Rahmen entfernt mit:
.ChartArea.Border.LineStyle = xlNone

Grüße
Nils


Beiträge aus den Excel-Beispielen zum Thema "[VBA] Diagramme als Bild speichern geht nicht mehr"