15.06.2018, 09:44
Hallo zusammen,
ich erzeuge ein Punktdiagramm, welches ich gerne beschriften möchte. Dies soll je der erste Buchstabe des Nach- und des Vornamens sein. Leider wird mir jedoch nur der erste Buchstabe des Nachnamens angezeigt, hat da jemand eine Idee?
ich erzeuge ein Punktdiagramm, welches ich gerne beschriften möchte. Dies soll je der erste Buchstabe des Nach- und des Vornamens sein. Leider wird mir jedoch nur der erste Buchstabe des Nachnamens angezeigt, hat da jemand eine Idee?
Code:
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
ActiveChart.SeriesCollection(1).XValues = "=Gehaltsdaten!$G$3:$G$800"
ActiveChart.SeriesCollection(1).Values = "=Gehaltsdaten!$AC$3:$AC$800"
ActiveChart.location Where:=xlLocationAsObject, _
name:=ThisWorkbook.Worksheets(4).name
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
Call BeschriftungDiagramm
End Sub
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) & " " & Left(data.Cells(lngPunkt + 2, 3), 1)
Next lngPunkt
End With
End Sub