VBA Problem, Datenbeschriftung positionieren
08.09.2006 18:36:04
Peter
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