Diagramm-Datenbeschriftung individuell anpassen

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