Legendenfarbe ändern VBA

Hallo
ich möchte bei einem Oberflächendiagramm, der Legende andere Farben zuweisen(RegenbogenMuster aus array). Hab aber folgendes Problem dabei:
Wenn ich beim Legendeneintrag1 anfange bringt er mir einen Laufzeitfehler 1004, wenn ich bei Legendeneintrag höher wie 10 anfange färbt er mir die Werte richtig ein
Wieso kann er nicht bei 1 beginnen?
'-------30 Punkte Legende erstellen--------
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.Legend.Select
With ActiveChart.Axes(xlValue)
.MinimumScale = 70
.MaximumScale = 100
.MinorUnitIsAuto = True
.MajorUnit = 1
'.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
'-----Legende einfärben----------
' Array fuer Farbcode
Dim feld(30) As Variant
feld(1) = 18
feld(2) = 13
feld(3) = 39
feld(4) = 47
feld(5) = 55
feld(6) = 11
feld(7) = 5
feld(8) = 41
feld(9) = 33
feld(10) = 8
feld(11) = 42
feld(12) = 37
feld(13) = 34
feld(14) = 14
feld(15) = 50
feld(16) = 10
feld(17) = 4
feld(18) = 43
feld(19) = 35
feld(20) = 2
feld(21) = 19
feld(22) = 36
feld(23) = 6
feld(24) = 44
feld(25) = 40
feld(26) = 45
feld(27) = 46
feld(28) = 3
feld(29) = 53
feld(30) = 9
ActiveSheet.ChartObjects("Diagramm 1").Activate
i = 1
ActiveSheet.ChartObjects("Diagramm 1").Activate
' For Schleife 30mal ausfuehren zum einfaerben
For u = 1 To 30 Step 1
ActiveChart.Legend.LegendEntries(u).LegendKey.Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
' Farbe i ändern
With Selection.Interior
.ColorIndex = feld(i)
.Pattern = xlSolid
i = i + 1
End With
Next u

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Benutzer

Hallo Uli,
bei mir funktioniert dein Code ohne Probleme.
Wo dann bei dir das Problem ist: ?
Ich konnte z.B. aber den Fehler 1004 generieren, nachdem ich manuell einen Wertebereich in der Legende des Diagramm löschte.
Durch komplett neu anlegen der Legende im Makro wurde der Fehler dann vermieden.
Durch Verwendung einer Objekt-Variablen für das Chart kann man jedoch die verschiedenen Activate und Select-Anweisungen vermeiden.
Gruß
Franz

Sub aaTest()
'-------30 Punkte Legende erstellen--------
Dim i As Long, u As Long, oChart As Chart
Application.ScreenUpdating = False
Set oChart = ActiveSheet.ChartObjects("Diagramm 1").Chart
With oChart
.HasLegend = False 'Legende ausblenden
.HasLegend = True 'Legende einblenden
With .Legend
.Position = xlLegendPositionBottom
End With
With .Axes(xlValue)
.MinimumScale = 70
.MaximumScale = 100
.MinorUnitIsAuto = True
.MajorUnit = 1
'.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
End With
'-----Legende einfärben----------
' Array fuer Farbcode
Dim feld(30) As Variant
feld(1) = 18
feld(2) = 13
feld(3) = 39
feld(4) = 47
feld(5) = 55
feld(6) = 11
feld(7) = 5
feld(8) = 41
feld(9) = 33
feld(10) = 8
feld(11) = 42
feld(12) = 37
feld(13) = 34
feld(14) = 14
feld(15) = 50
feld(16) = 10
feld(17) = 4
feld(18) = 43
feld(19) = 35
feld(20) = 2
feld(21) = 19
feld(22) = 36
feld(23) = 6
feld(24) = 44
feld(25) = 40
feld(26) = 45
feld(27) = 46
feld(28) = 3
feld(29) = 53
feld(30) = 9
i = 1
' For Schleife 30mal ausfuehren zum einfaerben
For u = 1 To 30 Step 1
With oChart.Legend.LegendEntries(u).LegendKey
With .Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
' Farbe i ändern
With .Interior
.ColorIndex = feld(i)
.Pattern = xlSolid
i = i + 1
End With
End With
Next u
Application.ScreenUpdating = True
End Sub

Beliebteste Forumthreads (12 Monate)

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread