Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
800to804
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
800to804
800to804
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

VBA Problem, Datenbeschriftung positionieren

VBA Problem, Datenbeschriftung positionieren
08.09.2006 18:36:04
Peter
Hallo,
in einem xy-Punktdiagramm lasse ich mir die Beschriftung der Datenpunkte per Maus-Klick anzeigen. Ich möchte die Beschriftungen (DataLabel), egal von welchem Punkt, immer an ein und der selben Stelle auf dem Diagramm-Blatt positionieren. Einen Teil meines Codes habe ich unten reingestellt. Ich weiss das man mit Datalabel.Top oder Left positionieren kann.
Wie ist der Code richtig und wo muss ich ihn einbauen?
folgende 2 Varianten hab ich schon probiert:
1.
For Each chtLabel In chtSeries.DataLabels
chtLabel.Top = chtLabel.Top - 10
chtLabel.Left = chtLabel.Left + 10
Next chtLabel
2.
For Each xlColPoint In _
xlChartObj.SeriesCollection(1).Points
xlColPoint.DataLabel.Top = _
xlColPoint.DataLabel.Top - 10
xlColPoint.DataLabel.Left = _
xlColPoint.DataLabel.Left + 10
Next xlColPoint
Wie ist es richtig?
mein gesamter Code:

Private Sub Chart_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal y As Long)
Dim ElementID As Long, Arg1 As Long, Arg2 As Long
Dim myX As Variant, myY As Double
' kurzzeitig die Aktualisierung der Darstellung unterbrechen
Application.ScreenUpdating = False
With ActiveChart
' Pass x & y, return ElementID and Args
.GetChartElement X, y, ElementID, Arg1, Arg2
'If ElementID = xlShape Then
'MsgBox ("Elemetid: " & ElementID & "...Arg1:" & Arg1 & "...Arg2:" & agr2)
'MsgBox (Charts("Pflanzungs-Karte").Shapes("Drop Down 5").ControlFormat.Value)
'MsgBox (Charts("Pflanzungs-Karte").Shapes("Drop Down 5").Type)
'MsgBox (Charts("Pflanzungs-Karte").Shapes("Drop Down 5").FormControlType)
'If Charts("Pflanzungs-Karte").Shapes("Drop Down 5").FormControlType = xlDropDown Then
'If Charts("Pflanzungs-Karte").Shapes("Drop Down 5").Type = msoFormControl Then
'MsgBox ("Drop down")
'End If
'End If
' Did we click over a point or data label?
If ElementID = xlSeries Or ElementID = xlDataLabel Then
If Arg2 > 0 Then
' Extract x value from array of x values
myX = WorksheetFunction.index _
(.SeriesCollection(Arg1).XValues, Arg2)
' Extract y value from array of y values
myY = WorksheetFunction.index _
(.SeriesCollection(Arg1).Values, Arg2)
' Display message box with point information
'  MsgBox "Series " & Arg1 & vbCrLf _
'    & """" & .SeriesCollection(Arg1).Name & """" & vbCrLf _
'    & "Point " & Arg2 & vbCrLf _
'    & "X = " & myX & vbCrLf _
'    & "Y = " & myY
' Informationen des letzten angeklickten Punktes nicht mehr anzeigen
If altx <> 0 And alty <> 0 Then
With Charts("Pflanzungs-Karte").SeriesCollection(altx).Points(alty)
.HasDataLabel = False
End With
End If
' Informationen des aktuell angeklickten Punktes anzeigen
With Charts("Pflanzungs-Karte").SeriesCollection(Arg1).Points(Arg2)
.HasDataLabel = True
'die Beschriftung des Datensatzes als Text ausgeben
'.ApplyDataLabels Type:=xlDataLabelsShowLabel
' Text des Labels frei definieren:
' Text aus der Spalte J (in entsprechender Zeile) holen
.DataLabel.Text = Worksheets("Hilfe").Range("A" & Arg2 + 3)
' Schriftgrösse fest auf 8 einstellen
.DataLabel.Font.Size = 8
' Farbe des Textes setzen (1=schwarz)
.DataLabel.Font.ColorIndex = 1
' Positionieren der Datenbeschriftung
For Each xlColPoint In _
xlChartObj.SeriesCollection(1).Points
xlColPoint.DataLabel.Top = _
xlColPoint.DataLabel.Top - 11
xlColPoint.DataLabel.Left = _
xlColPoint.DataLabel.Left - 11
Next xlColPoint
End With
' aktuelle Werte für den nächsten klick merken
altx = Arg1
alty = Arg2
' Select auf das gesamte Diagramm setzen, damit die Punkte nicht Lila sind
ActiveChart.ChartArea.Select
End If
End If
End With
' Aktualisierung der Darstellung wieder anschalten
Application.ScreenUpdating = True
End Sub

Grüße aus Berlin

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA Problem, Datenbeschriftung positionieren
10.09.2006 13:55:48
fcs
Hallo Peter,
mit folgenden Anpassungen wird die Datenpunkt-Information, des angeklickten Punktes an einer fixen Position im Chart angezeigt:

Private altx, alty
Private Sub Chart_Activate()
Dim Datenreihe As Series
' vorhandene  Datenlabels der Datenreihen ausblenden beim Aktivieren des Charts
For Each Datenreihe In Me.SeriesCollection
Datenreihe.HasDataLabels = False
Next
End Sub
Private Sub Chart_MouseUp(ByVal Button As Long, ByVal Shift As Long, ByVal X As Long, ByVal y As Long)
Dim ElementID As Long, Arg1 As Long, Arg2 As Long
Dim myX As Variant, myY As Double
' kurzzeitig die Aktualisierung der Darstellung unterbrechen
Application.ScreenUpdating = False
With ActiveChart
' Pass x & y, return ElementID and Args
.GetChartElement X, y, ElementID, Arg1, Arg2
' Did we click over a point or data label?
If ElementID = xlSeries Or ElementID = xlDataLabel Then
If Arg2 > 0 Then
' Extract x value from array of x values
myX = WorksheetFunction.Index _
(.SeriesCollection(Arg1).XValues, Arg2)
' Extract y value from array of y values
myY = WorksheetFunction.Index _
(.SeriesCollection(Arg1).Values, Arg2)
' Informationen des letzten angeklickten Punktes nicht mehr anzeigen
If altx <> 0 And alty <> 0 Then
With Charts("Pflanzungs-Karte").SeriesCollection(altx).Points(alty)
.HasDataLabel = False
End With
End If
' Informationen des aktuell angeklickten Punktes anzeigen
With Charts("Pflanzungs-Karte").SeriesCollection(Arg1).Points(Arg2)
.HasDataLabel = True
'die Beschriftung des Datensatzes als Text ausgeben
'.ApplyDataLabels Type:=xlDataLabelsShowLabel
' Text des Labels frei definieren:
' Text aus der Spalte J (in entsprechender Zeile) holen
.DataLabel.Text = Worksheets("Hilfe").Range("A" & Arg2 + 3)
' Schriftgrösse fest auf 8 einstellen
.DataLabel.Font.Size = 8
' Farbe des Textes setzen (1=schwarz)
.DataLabel.Font.ColorIndex = 1
' Positionieren der Datenbeschriftung
.DataLabel.Top = Me.ChartArea.Top + 50
.DataLabel.Left = Me.ChartArea.Top + 50
End With
' aktuelle Werte für den nächsten klick merken
altx = Arg1
alty = Arg2
' Select auf das gesamte Diagramm setzen, damit die Punkte nicht Lila sind
ActiveChart.ChartArea.Select
End If
End If
End With
' Aktualisierung der Darstellung wieder anschalten
Application.ScreenUpdating = True
End Sub

Gruss
Franz
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige