XY-Punkt-Diagramm beschriften

XY-Punkt-Diagramm beschriften. 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 Datenbeschriftungen 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, dass 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' (Schaltflächen kann man auf einem Tabellenblatt einfügen).
Bei Klick auf die Schaltfläche 'Diagramm zurücksetzen' wird die Datenbeschriftung wieder entfernt.
Public resetcode As Boolean
Sub auto_open()
resetcode = True
End Sub
Sub AttachLabelsToPoints()
Prüft um sicherzustellen, dass 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, dass 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 diesen Seiten interessant fanden, freuen wir uns über Ihren Förderbeitrag. Empfehlen Sie uns auch gerne in Ihren Netzwerken. Herzlichen Dank!

Nutzen Sie unsere Suchfunktion:

Nach oben Sitemap
Impressum Datenschutz

Hinweis: Diese Webseite kann Werbeanzeigen und Werbeeinblendungen oder eingebundene Links von Diensten und Inhalten Dritter enthalten. Beachten Sie dazu unsere Datenschutzerklärung.