| Datenfelder |
| | | | | | |
| | | | | | |
| Beschriftung | X-Werte | Y-Werte | | | | |
| Datenfeld 1 | 2 | 5 | | | |
| Datenfeld 2 | 4 | 4 | | | |
| Datenfeld 3 | 6 | 2 | | | | |
| Datenfeld 4 | 8 | 3 | | | | |
| Datenfeld 5 | 10 | 6 | | | |
| | | | | |
 | | | | | | |
| | | | | | |
| | | | | | |
| | | | | | |
| | | | | | |
| | | | | | |
| | | | | | |
| | | | | | |
| | | | | | |
| | | | | | |
| | | | | | |
| | | | | | |
| | | | | | |
| | | | | | |
| | | | | | |
| Obwohl Microsoft Excel keine integrierte Möglichkeit für das automatische Anbringen von Daten- |
| beschriftungen in XY-Punkt-Diagrammen bietet, kann dieses mittels eines Makros erzielt werden. |
|
| Das nachfolgende Makro zeigt das Anbringen von Datenbeschriftungen in einem XY-Punkt- |
| Diagramm. Es wird vorausgesetzt, daß die Daten und Beschriftungen in Ihrem Tabellenblatt |
| dem obigen schattierten Zelleninhalt entsprechen. |
|
| Um die Datenpunkt-Beschriftungen einzufügen, klicken Sie auf die Schaltfläche 'Datenbeschriftung anbringen'. |
| Klicken Sie auf die Schaltfläche 'Diagramm zurücksetzen', um die Datenbeschriftung wieder zu entfernen. |
|
| Public resetcode As Boolean |
|
| Sub auto_open() |
| resetcode = True |
| End Sub |
|
| Sub AttachLabelsToPoints() |
| Prüft um sicherzustellen, daß die zugeordnete Beschriftung nur einmal ausgeführt wird. |
| If resetcode = False Then |
| MsgBox "Diagramm vor Beschriftung zurücksetzen", vbCritical |
| Exit Sub |
| End If |
| Dimensionsvariable. |
| Dim Counter As Integer |
| Dim SourceWorksheet As Variant, xVals As Variant, xCell As Variant |
| Dim xLabel As Variant |
| Bildschirmaktualisierung während Ausführung der Unterroutine deaktivieren. |
| Application.ScreenUpdating = False |
| Name des aktiven Diagramms in "ChartName" speichern. |
| ActiveSheet.ChartObjects(1).Select |
| Definition der ersten Datenreihe in "xVals" speichern. |
| xVals = ActiveChart.SeriesCollection(1).Formula |
| Diese Programmzeile extrahiert den Namen des Quelltabellenblatts aus xVals. |
| SourceWorksheet = Left(xVals, InStr(1, xVals, "!") - 1) |
| SourceWorksheet = Right(SourceWorksheet, Len(SourceWorksheet) - InStr(1, SourceWorksheet, "(")) |
| If Left(SourceWorksheet, 1) = "," Then |
| SourceWorksheet = Right(SourceWorksheet, Len(SourceWorksheet) - 1) |
| End If |
| Quelltabellenblattname mit "xlSheet" ersetzen, damit die anschließende |
| Suche richtig ausgeführt wird, falls der Arbeitsblattname Kommas enthält. |
| xVals = Application.Substitute(xVals, SourceWorksheet, "xlSheet") |
| Weitere Bearbeitung von xVals. |
| xVals = Right(xVals, Len(xVals) - InStr(1, xVals, ",")) |
| Wenn das Diagramm "angenommene" x-Werte verwendet, Warnmeldung anzeigen. |
| If Left(xVals, 1) = "," Then |
| HINWEIS: Die nachfolgenden zwei Zeilen müssen als eine Gesamtzeile eingegeben werden. |
| MsgBox "Dieses X-Y-Diagramm verwendet 'angenommene'X-Werte." & "Makro kann nicht fortfahren." |
| Unterroutine verlassen, wenn 'angenommene'x-Werte angewendet werden. |
| Exit Sub |
| End If |
| Weitere Bearbeitung von xVals. |
| xVals = Left(xVals, InStr(1, xVals, ",") - 1) |
| Liefert den Quelltabellenblattnamen wieder an xVals und ersetzt somit "xlSheet". |
| xVals = Application.Substitute(xVals, "xlSheet", SourceWorksheet) |
| Zähler initialisieren. |
| Counter = 1 |
| Für jede Zelle im Bereich xVals... |
| For Each xCell In Range(xVals) |
| Übernehme den Wert der Beschriftung nach dem derzeitigen x-Wert. |
| xLabel = xCell.Offset(0, -1).Value |
| Beschriftung dem derzeitigen Datenpunkt im Diagramm hinzufügen. |
| ActiveChart.SeriesCollection(1).Points(Counter).HasDataLabel = True |
| Den Text (z.B. "DataPoint1") der Beschriftung hinzufügen. |
| ActiveChart.SeriesCollection(1).Points(Counter).DataLabel.Text = xLabel |
| Zähler inkrementieren. |
| Counter = Counter + 1 |
| Next xCell |
| Sicherstellen, daß nichts im Diagramm ausgewählt ist. |
| Application.ExecuteExcel4Macro "SELECT("""")" |
| resetcode = False |
| End Sub |
|
| Sub ResetChart() |
| Diese Unterroutine setzt das Diagramm zurück, damit die Beschriftung angebracht werden kann. |
| Application.ScreenUpdating = False |
| ActiveSheet.ChartObjects.Select |
| Selection.Delete |
| Charts.Add |
| With ActiveChart |
| .ChartType = xlXYScatter |
| .SetSourceData Source:=Sheets("XY-Diagramm").Range("B3:C7"), PlotBy:=xlColumns |
| .Location Where:=xlLocationAsObject, Name:="XY-Diagramm" |
| End With |
| Application.ScreenUpdating = True |
| resetcode = True |
| End Sub |
| | | | | | |
zurück