Axel Richter: Grafik aus Excel kitzeln

Beitrag lesen

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  

viele Grüße

Axel