[VBA] Diagramme als Bild speichern geht nicht mehr
04.12.2017 16:35:57
Nils
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