Hallo liebe Leute,
mein Makro funktioniert zum größten Teil schon. Folgendes klappt nicht:
Zuerst wird das Diagramm 1 skaliert, das funktioniert noch:
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveSheet.Shapes("Diagramm 1").ScaleWidth 2, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Diagramm 1").ScaleHeight 2, msoFalse, _
msoScaleFromTopLeft
Gleich anschließend soll die Farbe des ersten Legendeneintrags geändert werden:
With ActiveSheet.ChartObjects("Diagramm 1").Chart.Legend
With .LegendEntries(1).Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(255, 0, 0)
.Transparency = 0
End With
End With
Doch leider erscheint folgende Fehlermeldung:
"Die Methode 'Line' für das Objekt 'ChartFormat' ist fehlgeschlagen"
Führe ich die Farbänderung manuell durch, erscheint beim ersten mal immer ein Kastl mit folgendem Hinweis:
"Die Anzeige der komplexen Formartierung, die auf die ausgewählte Tabelle angewendet wurde, kann einige Zeit in Anspruch nehmen. Möchten Sie die Verwendung der Formatierung fortsetzen? - Ja/Nein"
Ich nehme an die Frage rührt daher, dass das Dokument "relativ" groß ist und dieser Schritt daher viel Rechenzeit in Anspruch nimmt. Ich beantworte jedenfalls mit "Ja" und dann führt er den Schritt aus.
Führe ich weitere Farbänderungen mit diesem oder einem anderen Legendeneintrag aus, erscheint dieses Hinweiskastl nichtmehr. Deswegen war meine Therorie, dass das Makro intern ebenfalls auf diesen Hinweiß stößt, damit überfordert ist, abbricht und die oben erwähnte Fehlermeldung ausgibt. Leider scheint meine Theorie nicht zu stimmen, da die Ausführung des Makros auch dann fehlschlägt, wenn ich zuvor schon eine manuelle Farbänderung vorgenommen (und das Hinweiskastl mit "Ja" beantwortet) hab.
Kann mir jemand weiterhelfen?
Gruß,
Martin
Hier ist der gesamte Code angehängt falls es was bringt:
Sub Makro_Diagramm()
'
' Makro_Diagramm Makro
'
' Tastenkombination: Strg+Umschalt+D
'
Columns("A:A").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A1").Select
ActiveCell.Value = "Time in sec"
Range("B1").Select
ActiveCell.Value = "Time dissection"
Range("A2").Select
ActiveCell.Value = "=B2/1000"
Range("B2").Select
ActiveCell.Value = "=0"
Range("A3").Select
ActiveCell.Value = "=B3/1000"
Range("B3").Select
ActiveCell.FormulaLocal = "=LINKS(C3;2)*3600000+TEIL(C3;4;2)*60000+TEIL(C3;7;2)*1000+RECHTS(C3;3)-(LINKS(C2;2)*3600000+TEIL(C2;4;2)*60000+TEIL(C2;7;2)*1000+RECHTS(C2;3))+B2"
LastRow = ActiveSheet.UsedRange.Rows.Count
Range("A3:B3").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A3:B" & LastRow)
If Range("R1").Value = "L1_AI (V)" Then
Range("A:A,D:D,I:I,R:R,S:S,T:T,U:U").Select
Range("U1").Activate
ElseIf Range("S1").Value = "L1_AI (V)" Then
Range("A:A,D:D,I:I,S:S,T:T,U:U,V:V").Select
Range("V1").Activate
End If
ActiveSheet.Shapes.AddChart2(240, xlXYScatterLinesNoMarkers).Select
'ActiveChart.SetSourceData Source:=Range( _
' "AktiveSheet.Name!$A:$A,AktiveSheet.Name!$D:$D,AktiveSheet.Name!$I:$I,AktiveSheet.Name!$R:$R,AktiveSheet.Name!$S:$S,AktiveSheet.Name!$T:$T,AktiveSheet.Name!$U:$U" _
' )
ActiveChart.Parent.Cut
Sheets.Add After:=ActiveSheet
ActiveSheet.Paste
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveSheet.Shapes("Diagramm 1").ScaleWidth 2, msoFalse, _
msoScaleFromTopLeft
ActiveSheet.Shapes("Diagramm 1").ScaleHeight 2, msoFalse, _
msoScaleFromTopLeft
' With ActiveSheet.ChartObjects("Diagramm 1").Chart.Legend
' With .LegendEntries(1).Format.Line
' .Visible = msoTrue
' .ForeColor.RGB = RGB(255, 0, 0)
' .Transparency = 0
' End With
'
' With .LegendEntries(2).Format.Line
' .Visible = msoTrue
' .ForeColor.RGB = RGB(255, 0, 255)
' .Transparency = 0
' End With
'
' With .LegendEntries(3).Format.Line
' .Visible = msoTrue
' .ForeColor.ObjectThemeColor = msoThemeColorText1
' .ForeColor.TintAndShade = 0
' .ForeColor.Brightness = 0
' .Transparency = 0
' End With
' End With
End Sub
|