VBA Problem mit Diagramm (DataLabel)
06.09.2006 19:16:19
Peter
ich habe ein XY-Punktdiagramm ("Pflanzungs-Karte") auf dem mit Hilfe des folgenden Codes bei Maus-Klick auf einen Punkt, Punktspezifische Informationen aus dem Tabellenblatt "Hilfe", Spalte A, ab A4, angezeigt werden. Ich weiss leider nicht wie ich es schaffe, dass das Datenfenster, egal welchen Punkte ich angeklickt habe, immer an einer bestimmten Position erscheint.
Die Sache mit den Konstanten Positionen, z.B.:
.DataLabel.Position = xlLabelPositionOutsideEnd
funktioniert nicht und reicht auch nicht aus. Was kann man da machen?
mein 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)
'Position des DataLabels
.DataLabel.Position = xlLabelPositionOutsideEnd
' Schriftgrösse fest auf 8 einstellen
.DataLabel.Font.Size = 8
' Farbe des Textes setzen (1=schwarz)
.DataLabel.Font.ColorIndex = 1
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