XY-Punkt-Diagramm beschriften

XY-Punkt-Diagramm beschriften. Datenfelder
Beschriftung X-Werte Y-Werte
Textfeld: 1.) Diagramm zurücksetzen
Datenfeld 1 2 5
Datenfeld 2 4 4
Datenfeld 3 6 2
Datenfeld 4 8 3
Textfeld: 2.) Datenbeschriftung anbringen
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
Sponsoren und Investoren

Sponsoren und Investoren sind jederzeit herzlich willkommen!
Wenn Sie die Information(en) auf dieser Seite interessant fanden, freuen wir uns über eine kleine Spende. Empfehlen Sie uns bitte auch in Ihren Netzwerken (z. B. Twitter, Facebook oder Google+). Herzlichen Dank!

Nach oben Sitemap
Impressum & Kontakt