Diagramm-Datenbeschriftung individuell anpassen
24.06.2015 14:25:56
Ernst
habe folgendes Problem. Ich habe ein Makro bei dem aus einem langen Datenpool mehrere Reiter inklusive Diagrammen erstellt werden.
Die Diagramme sind Säulendiagramme und ich würde gerne die Datenbeschriftung individuell gestalten. Es soll letztlich so aussehen, dass die Inhalte jeden Reiters der Zellen F2-F7 die Beschriftungen der verschiedenen Säulen des Diagramms darstellen.
Das bisherige Makro ist:
Sub DiasErstellen()
Dim lngLetzte As Long
Dim lngZeile As Long
Dim wksTab As Worksheet
' letzte belegte Zeile in Spalte B ermitteln
lngLetzte = IIf(IsEmpty(Cells(Rows.Count, 2)), Cells(Rows.Count, 2).End(xlUp).Row, Rows. _
_
Count)
' Bildschirmaktualisierung aus
Application.ScreenUpdating = False
With Worksheets("Alle Daten")
' Schleife über alle Zeilen in 6er Schritten
For lngZeile = 2 To lngLetzte Step 6
' Tabellenblatt hinzufügen
Set wksTab = Worksheets.Add
' an die letzte Position schieben
wksTab.Move after:=Worksheets(Worksheets.Count)
' laufenden Zellbereich aus "Alle Daten" in neues Tabellenblatt kopieren
.Range(.Cells(lngZeile, 1), .Cells(lngZeile + 5, 6)).Copy wksTab.Range("A2:D7")
' Überschrift kopieren
.Range("A1:D1").Copy wksTab.Range("A1")
With wksTab
' Name des Tabellenblattes
.Name = .Range("A2")
' Diagramm hinzufügen
With .Shapes.AddChart(0, 0, 0, 0).Chart
.ChartType = xlColumnStacked100
' Wertebereich hinzufügen
.SetSourceData Source:=wksTab.Range("B1:D7")
' Achsenbeschriftung hinzufügen
.SeriesCollection(1).XValues = wksTab.Range("B2:B7")
ActiveSheet.ChartObjects("Diagramm 1").Activate
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).ApplyDataLabels
ActiveChart.SeriesCollection(1).DataLabels.Select
Selection.Position = xlLabelPositionInsideBase
ActiveChart.Legend.Select
ActiveChart.SetElement (msoElementLegendBottom)
' Diagramm positionieren
With .Parent
.Top = Range("E3").Top
.Left = Range("E3").Left
.Height = 300
.Width = 550
End With
End With
End With
Next lngZeile
End With
' Bildschirmaktualisierung ein
Application.ScreenUpdating = True
End Sub
Ist es denn möglich, die Datenbeschriftung der einzelnen Säulen individuell zu verändern und im Prinzip den Inhalt der Zelle F2 zur ersten Säule, den Inhalt F3 zur nächsten Säule, etc. hinzuzuschreiben?
Ich danke Euch für Eure Hilfe.
Liebe Grüße
Ernst