12.07.2018, 10:14
Hallo zusammen,
ich erzeuge ein Punktdiagramm, wobei die Datenpunkte jeweils mit dem ersten Buchstaben des Vor- und Nachnamens beschriftet werden sollen. Leider erfolgt die Beschriftung nach Filtern nicht korrekt, sprich die Punkte werden korrekt abgebildet, jedoch verrutschen die Zuordnungen, sodass dort "falsche" Namen stehen.
Bin über jede Hilfe dankbar :)
ich erzeuge ein Punktdiagramm, wobei die Datenpunkte jeweils mit dem ersten Buchstaben des Vor- und Nachnamens beschriftet werden sollen. Leider erfolgt die Beschriftung nach Filtern nicht korrekt, sprich die Punkte werden korrekt abgebildet, jedoch verrutschen die Zuordnungen, sodass dort "falsche" Namen stehen.
Bin über jede Hilfe dankbar :)
Code:
'Erzeugung des Graphen und Zuweisung der Daten aus dem Tabellenblatt "Gehaltsdaten"
Sub ErzeugungGraph()
Dim data As Worksheet
Dim name As Range
Set data = ActiveWorkbook.Worksheets("Gehaltsdaten")
Application.ScreenUpdating = False
Worksheets("Gehaltsdaten").Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=data.Range("A3:AC3000")
ActiveChart.SeriesCollection.NewSeries
With ActiveChart.SeriesCollection(1)
.XValues = "=Gehaltsdaten!$G$3:$G$800"
.Values = "=Gehaltsdaten!$AC$3:$AC$800"
.name = "=Gehaltsdaten!$B$3:$B$800"
.Trendlines.Add Type:=xlLinear
End With
ActiveChart.location Where:=xlLocationAsObject, _
name:=ThisWorkbook.Worksheets(4).name
'Formatierung des Graphen
With ActiveChart
.PlotArea.Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
.HasLegend = False
.Parent.Height = 600
.Parent.Width = 1200
.HasTitle = True
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "Alter"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "JEK 35H"
.Axes(xlValue).MinimumScale = 0
.Axes(xlCategory).MaximumScale = 80
.SeriesCollection(1).Format.Fill.ForeColor.RGB = rgbBlue
End With
Worksheets(4).ChartObjects(1).Activate
With ActiveChart
.Axes(xlValue).AxisTitle.Font.Size = 20
.Axes(xlCategory).AxisTitle.Font.Size = 20
.PlotArea.Interior.ColorIndex = 15
End With
'Aufrufen des Programms zur Beschriftung der Datenpunkte
Call BeschriftungDiagramm
End Sub
'Beschriftet die Datenpunkte mit je dem ersten Buchstaben des Nach- und Vornamens
Sub BeschriftungDiagramm()
Dim lngPunkt As Long
Dim data As Worksheet
Set data = ActiveWorkbook.Worksheets("Gehaltsdaten")
With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
.ApplyDataLabels
For lngPunkt = 1 To .Points.Count
.Points(lngPunkt).DataLabel.Text = Left(data.Cells(lngPunkt + 2, 2), 1) & " " & Mid(data.Cells(lngPunkt + 2, 3), 2, 1)
Next lngPunkt
End With
End Sub
Sub LöschenDiagramm()
ActiveSheet.ChartObjects(1).Delete
End Sub