bei klick Punkteigenschaften im Diagramm ändern
23.01.2007 18:36:10
Peter
ich hatte folgendes Problem schon einmal reingestellt, bin leider nicht zu einer Lösung gekommen.
Ich beschreibe mein Anliegen noch einmal näher.
1. Ich habe ein x-y-Punktdiagramm.
2. Wenn ich einen Punkt anklicke soll dieser größer werden (Größe soll gleich der Zahl im Blatt "Hilfe" Zelle AR4 sein)(.MarkerSize = Sheets("Hilfe").Range("$AR$4").Value)
3. Außerdem soll dieser Punkt einen schwarzen Rahmen bekommen (MarkerForegroundColor = RGB(0, 0, 0) ' schwarz)
4. Die BackgroundColor soll so bleiben wie sie war.
Ich muß, nachdem ich einen Punkt angeklickt habe, noch wissen welche Farbe er hat (BackgroundColor)und auch welche Farben die anderen Punkte haben.
Diese wird vorher über ein anderes Makro für jeden einzelnen Punkt je nach Auswahl eines anderen Parameters immer neu bestimmt, d.h. die Punkte haben unterschiedliche Farben. Diese unterschiedlichen Farben repräsentieren Noten (von 1-6).
5. Wenn ich einen weiteren Punkt anklicke soll der vorherige seine ursprünglichen Eigenschaften wiederbekommen (MarkerForegroundColor gleich BackgroundColor, Größe gleich Zahl aus Blatt "Hilfe" Zelle AR3, alle Punkte die nicht angeklickt sind bekommen daher ihre Größe)(der angeklickte Punkt erhält die Größe aus AR4 !!!)
Der neu angeklickte Punkt soll sich wie oben beschrieben verhalten, usw..
Ich bitte darum notwendige Anpassungen, in den folgenden, von mir verwendeten und für meine Textbox 87 schon funktionierenden Code, einzubauen.
Meinen Versuch seht Ihr unten.
Dort habe ich nur für Punkt 50 nach klick die Eigenschaften ändern können.
Erläuterungen zur Textbox: (vielleicht wichtig?!)
Der Text für Textbox 87 wird aus Spalte A aus dem TabellenBlatt "Hilfe" ausgelesen, wenn CheckBox 21 ein Häckchen hat. In einer Zeile und in 3 Spalten nebeneinander stehen Text, X-Koordinate, Y-Koordinate. Bei jedem Klick auf einen Punkt wird somit der entsprechende Text ausgelesen.
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)
' aktuelle Werte für den nächsten klick merken
altx = Arg1
alty = Arg2
' In die Textbox den Text eintragen
If .Shapes("Check Box 21").ControlFormat.Value = 1 Then
Charts("Pflanzungs-Karte").Shapes("Text Box 87").Visible = True
Charts("Pflanzungs-Karte").Shapes("Text Box 87").Select
Selection.Characters.Text = Worksheets("Hilfe").Range("A" & Arg2 + 3)
Else
Charts("Pflanzungs-Karte").Shapes("Text Box 87").Visible = False
End If
'ES GEHT IN ETWA UM DIESEN CODE
' angeklickten Punkt mit schwarzen Rahmen markieren und größer machen
With Charts("Pflanzungs-Karte").SeriesCollection(1).Points(50)
.MarkerForegroundColor = RGB(0, 0, 0) ' schwarz
.MarkerSize = Sheets("Hilfe").Range("$AR$4").Value
End With
Else
Charts("Pflanzungs-Karte").Shapes("Text Box 87").Visible = False
End If
' Select auf das gesamte Diagramm setzen, damit die Punkte nicht Lila sind
ActiveChart.ChartArea.Select
Else
Charts("Pflanzungs-Karte").Shapes("Text Box 87").Visible = False
End If
End With
' Aktualisierung der Darstellung wieder anschalten
Application.ScreenUpdating = True
End Sub
Danke im voraus
Grüße aus Berlin