mehrere Diagramme aus Tabelle

Informationen und Beispiele zu den hier genannten Dialog-Elementen:
Label


Excel-Version: 97
nach unten

Betrifft: mehrere Diagramme aus Tabelle
von: Ingo J.
Geschrieben am: 11.05.2002 - 10:46:10

Hallo,

Ich habe da ein Problem mit der Diagrammerstellung durch ein Makro und brauche da mal ein wenig Hilfe.

Folgender Sachverhalt
Ich möchte aus meiner Tabelle mehrere Diagramme a 15 Balken bilden.
Nun habe ich mir folgendes Makro zusammengeschrieben:

Sub Diagramm()
Dim x As Long
Dim y As Long
Dim BlaNa As String
BlaNa = ActiveSheet.Name
For x = 2 To 100
y = 14 + x

Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets(BlaNa).Range(Sheets(BlaNa).Cells(x, 100) _
.Address & ":" & Sheets(BlaNa).Cells(y, 101).Address), PlotBy:=xlColumns
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False

ActiveChart.HasLegend = False
ActiveChart.Location Where:=xlLocationAsNewSheet
With ActiveChart
.HasTitle = True
.ChartTitle.Text = "Gesamtübersicht aller Verursacher bei " & summe & " Schadmeldungen"
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Verursacher"
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Anzahl"
End With
ActiveChart.Axes(xlValue).MajorGridlines.Select
With ActiveChart.Axes(xlValue)
.MaximumScale = 180
End With
ActiveChart.Axes(xlCategory).Select
With Selection.TickLabels.Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 6
End With
Selection.TickLabels.Orientation = xlUpward
ActiveChart.PlotArea.Select
Selection.Interior.ColorIndex = xlNone

x = x + 15
Next x

End Sub

Das makro hat nur eine Macke im letzte Diagramm wirden die Werte für die Beschriftung der X Achse in eine neue Datenreihe geschrieben.
Kann mir jemand sagen wo ich einen Fehler gemacht habe.
Es gibt bestimmt auch eine bessere Lösung um die Diagramme zu erzeugen.

Ich bin für jeden Rat dankbar.

MfG
Ingo

nach oben   nach unten

Lösung gefunden
von: Ingo J.
Geschrieben am: 11.05.2002 - 17:55:56

Hi,

habe nach langen probieren Lösung gefunden
für die die es interessiert so sieht sie aus

For x = 2 To laR
y = 14 + x

Charts.Add
ActiveChart.ChartType = xlColumnClustered
ActiveChart.SetSourceData Source:=Sheets(BlaNa).Range(Sheets(BlaNa).Cells(x, 100) _
.Address & ":" & Sheets(BlaNa).Cells(y, 101).Address), PlotBy:=xlColumns
ActiveChart.ApplyDataLabels Type:=xlDataLabelsShowValue, LegendKey:=False
ActiveChart.SeriesCollection(1).Delete
If y >= laR Then
ActiveChart.SeriesCollection(1).Delete
Else: End If
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(1).Values = Sheets(BlaNa).Range(Sheets(BlaNa).Cells(x, 101) _
.Address & ":" & Sheets(BlaNa).Cells(y, 101).Address)
ActiveChart.SeriesCollection(1).XValues = Sheets(BlaNa).Range(Sheets(BlaNa).Cells(x, 100) _
.Address & ":" & Sheets(BlaNa).Cells(y, 100).Address)
ActiveChart.HasLegend = False
ActiveChart.Location Where:=xlLocationAsNewSheet
With ActiveChart
.HasTitle = True
.ChartTitle.Text = "Gesamtübersicht aller Verursacher bei " & summe & " Schadmeldungen"
.ChartTitle.AutoScaleFont = False
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Verursacher"
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "Anzahl"
.Axes(xlValue).MinimumScale = 0
.Axes(xlValue).MaximumScale = 160
.Axes(xlValue).TickLabels.Font.Size = 8
.SeriesCollection(1).DataLabels.Font.Size = 8
.Axes(xlCategory).TickLabels.Font.Size = 8
.Axes(xlCategory).TickLabels.Orientation = xlUpward
.PlotArea.Interior.ColorIndex = xlNone
End With

x = x + 15
Next x

für jeden einfacheren Weg wäre ich trotzdem dankbar

MfG
Ingo

 nach oben

Beiträge aus den Excel-Beispielen zum Thema "mehrere Diagramme aus Tabelle"