AW: sheet überschreiben
04.08.2005 15:46:57
S.Engelken
so siehts aus:
Sub RankingGesamt()
Sheets("Start").Select
Range("G53:M57").Select
Selection.Sort Key1:=Range("M57"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("G53:L57").Select
Charts.Add
ActiveChart.ChartType = xlColumnStacked
ActiveChart.SetSourceData Source:=Sheets("Start").Range("G53:L57"), PlotBy _
:=xlColumns
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection(1).Delete
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).XValues = "=Start!R53C7:R57C7"
ActiveChart.SeriesCollection(1).Values = "=Start!R53C12:R57C12"
ActiveChart.SeriesCollection(1).Name = "=Start!R52C12"
ActiveChart.SeriesCollection(2).XValues = "=Start!R53C7:R57C7"
ActiveChart.SeriesCollection(2).Values = "=Start!R53C11:R57C11"
ActiveChart.SeriesCollection(2).Name = "=Start!R52C11"
ActiveChart.SeriesCollection(3).XValues = "=Start!R53C7:R57C7"
ActiveChart.SeriesCollection(3).Values = "=Start!R53C10:R57C10"
ActiveChart.SeriesCollection(3).Name = "=Start!R52C10"
ActiveChart.SeriesCollection(4).XValues = "=Start!R53C7:R57C7"
ActiveChart.SeriesCollection(4).Values = "=Start!R53C9:R57C9"
ActiveChart.SeriesCollection(4).Name = "=Start!R52C9"
ActiveChart.SeriesCollection(5).XValues = "=Start!R53C7:R57C7"
ActiveChart.SeriesCollection(5).Values = "=Start!R53C8:R57C8"
ActiveChart.SeriesCollection(5).Name = "=Start!R52C8"
ActiveChart.Location Where:=xlLocationAsNewSheet, Name:="RankingGesamt"
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "Ranking: Gesamt"
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Häufigkeit"
End With
ActiveChart.Axes(xlValue).MajorGridlines.Select
With Selection.Border
.ColorIndex = 57
.Weight = xlHairline
.LineStyle = xlDot
End With
With ActiveChart.Axes(xlValue)
.MinimumScaleIsAuto = True
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnit = 4
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
End With
ActiveChart.PlotArea.Select
With Selection.Border
.ColorIndex = 57
.Weight = xlThin
.LineStyle = xlContinuous
End With
With Selection.Interior
.ColorIndex = 2
.PatternColorIndex = 52
.Pattern = xlSolid
End With
ActiveChart.ChartArea.Select
With Selection.Border
.Weight = xlHairline
.LineStyle = xlNone
End With
Selection.Shadow = False
Selection.Fill.OneColorGradient Style:=msoGradientVertical, Variant:=1, _
Degree:=1
With Selection
.Fill.Visible = True
.Fill.ForeColor.SchemeColor = 51
End With
ActiveChart.SeriesCollection(5).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 12
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(4).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 10
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(3).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 51
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(2).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 46
.Pattern = xlSolid
End With
ActiveChart.SeriesCollection(1).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlAutomatic
End With
Selection.Shadow = False
Selection.InvertIfNegative = False
With Selection.Interior
.ColorIndex = 14
.Pattern = xlSolid
End With
Sheets("Start").Select
End Sub
gruß