Diagramm-Legende ändert
27.07.2004 08:09:04
Chrigel
Wenn ich mit dem unten aufgeführten Code nur von einer Datenreihe ein Diagramm erzeuge, werden in der Legende die x-Werte der Datenreihe angezeigt und nicht deren Name. Wenn ich zwei Datenreihen einzeichne, sind die Legendeneinträge korrekt. Wie ist der Code zu ändern, dass die Legendeneinträge korrekt funktionieren? Als Beispiel habe ich eine Datei angehängt (https://www.herber.de/bbs/user/8909.xls).
Der Code generiert ein Chart nach meinen Bedürfnissen und markiert den Datenpunkt mit dem Maximalwert von der ersten Datenreihe.
Vielen Dank im voraus für die Antworten.
Gruss, Chrigel
Option Explicit
Sub CreateChart_1()
Dim objChart As ChartObject
Dim myChtRange As Range
Dim myDataRange As Range
With ActiveSheet
.ChartObjects.Delete
' What range should chart cover
Set myChtRange = .Range("A15:L35")
' What range contains data for chart
Set myDataRange = Application.InputBox( _
prompt:="Select a range containing the chart data.", _
Title:="Select Chart Data", Type:=8)
' Cover chart range with chart
Set objChart = .ChartObjects.Add( _
Left:=myChtRange.Left, Top:=myChtRange.Top, _
Width:=myChtRange.Width, Height:=myChtRange.Height)
' Put all the right stuff in the chart
With objChart.Chart
.ChartArea.AutoScaleFont = False
.ChartType = xlXYScatterLinesNoMarkers
.SetSourceData Source:=myDataRange
.HasTitle = False
.PlotArea.Fill.TwoColorGradient Style:=msoGradientHorizontal, Variant:=1
With .PlotArea
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 37
.Fill.BackColor.SchemeColor = 15
End With
With .Axes(xlCategory, xlPrimary)
.HasTitle = True
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlCustom
.CrossesAt = .MinimumScale
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
.MajorTickMark = xlInside
.MinorTickMark = xlNone
.TickLabelPosition = xlHigh
With .AxisTitle
.Characters.Text = "ChXTitle"
With .Font
.Size = 10
.Bold = False
.Name = "r_ansi"
.FontStyle = "Standard"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
End With
End With
With .Axes(xlValue, xlPrimary)
.HasTitle = True
With .AxisTitle
.Characters.Text = "ChYTitle"
With .Font
.Size = 10
.Bold = False
.Name = "r_ansi"
.FontStyle = "Standard"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
.Background = xlAutomatic
End With
End With
End With
End With
End With
Call MaxDpt_1(1, 1)
End Sub
Sub MaxDpt_1(n As Long, m As Long)
'markiert den Datenpunkt mit dem grössten Wert
Dim p As Long, pt As Point, DatArray()
DatArray = ActiveSheet.ChartObjects(n).Chart.SeriesCollection(m).Values
p = 1
For Each pt In ActiveSheet.ChartObjects(n).Chart.SeriesCollection(m).Points
If DatArray(p) = Application.Max(DatArray) Then
pt.HasDataLabel = True
pt.DataLabel.Text = "max. " & DatArray(p)
pt.MarkerBackgroundColorIndex = xlNone
pt.MarkerForegroundColorIndex = 1
pt.MarkerStyle = xlStar
pt.MarkerSize = 6
pt.Shadow = False
pt.DataLabel.Position = xlLabelPositionAbove
Else
pt.HasDataLabel = False
End If
p = p + 1
Next
End Sub