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