Grafik aus Excel kitzeln

[Axel Richter]

Hallo,

... 'nen HiWi oder ein Makro.

Sub einzeln_beschriftete_XY_Punkte()
'Vorausgesetzt wird die Markierung von Daten für X-Y-Punkte der folgenden Form:
'
'Punktbeschriftung     X-Wert  Y-Wert
'Beschriftung 1        100     200
'Beschriftung 2        200     100
'...
'
'Die Überschriften (Punktbeschriftung, X-Wert, Y-Wert) nicht mit markieren.
'
Dim ch As ChartObject
Set ch = ActiveSheet.ChartObjects.Add(100, 30, 400, 250)
With ch.Chart
    .ChartType = xlXYScatter
    .HasLegend = False

'Verbindungslinie, wenn gewünscht
    .SeriesCollection.NewSeries
    .SeriesCollection(.SeriesCollection.Count).Name = "Linie"
    .SeriesCollection(.SeriesCollection.Count).XValues = "='" & ActiveSheet.Name & "'!" & Selection.Range(Cells(1, 2), Cells(Selection.Rows.Count, 2)).Address
    .SeriesCollection(.SeriesCollection.Count).Values = "='" & ActiveSheet.Name & "'!" & Selection.Range(Cells(1, 3), Cells(Selection.Rows.Count, 3)).Address
    .SeriesCollection(.SeriesCollection.Count).ChartType = xlXYScatterLines
    .SeriesCollection(.SeriesCollection.Count).MarkerStyle = xlMarkerStyleNone

For r = 1 To Selection.Rows.Count
      .SeriesCollection.NewSeries
      .SeriesCollection(.SeriesCollection.Count).Name = "='" & ActiveSheet.Name & "'!" & Selection.Cells(r, 1).Address
      .SeriesCollection(.SeriesCollection.Count).XValues = "='" & ActiveSheet.Name & "'!" & Selection.Cells(r, 2).Address
      .SeriesCollection(.SeriesCollection.Count).Values = "='" & ActiveSheet.Name & "'!" & Selection.Cells(r, 3).Address
      .SeriesCollection(.SeriesCollection.Count).MarkerStyle = xlMarkerStyleAutomatic
      .SeriesCollection(.SeriesCollection.Count).ApplyDataLabels
      'Reihenname = Punktbeschriftung
      .SeriesCollection(.SeriesCollection.Count).DataLabels.ShowSeriesName = True
      'Kategoriename = X-Wert
      .SeriesCollection(.SeriesCollection.Count).DataLabels.ShowCategoryName = True
      'Wert = Y-Wert
      .SeriesCollection(.SeriesCollection.Count).DataLabels.ShowValue = True
      .SeriesCollection(.SeriesCollection.Count).DataLabels.Position = xlLabelPositionAbove
      .SeriesCollection(.SeriesCollection.Count).DataLabels.Separator = xlDataLabelSeparatorDefault
    Next
End With
End Sub

  
Kleine Korrektur:  
  
[Series].Name  
[Series].XValues  
[Series].Values  
  
können direkt Range-Objekte zugewiesen werden. Das müssen keine Texte sein. Die String-concatenation-Akrobatik von oben ist also nicht nötig:  
  

...
    .SeriesCollection(.SeriesCollection.Count).XValues = Selection.Range(Cells(1, 2), Cells(Selection.Rows.Count, 2))
    .SeriesCollection(.SeriesCollection.Count).Values = Selection.Range(Cells(1, 3), Cells(Selection.Rows.Count, 3))
...
      .SeriesCollection(.SeriesCollection.Count).Name = Selection.Cells(r, 1)
      .SeriesCollection(.SeriesCollection.Count).XValues = Selection.Cells(r, 2)
      .SeriesCollection(.SeriesCollection.Count).Values = Selection.Cells(r, 3)
...

  
viele Grüße  
  
Axel