VBA Diagramm MousDown mit mehreren Datenreihen
18.07.2013 13:57:17
Matthias
ich hab durch dieses Forum schon einiges gelernt. Vielen Dank dafür. Dennoch befinde ich mich eher im Anfangsstadium was VBA angeht.
Mein Problem ist die Beschriftung von Datenpunkten in einem Diagramm mit mehreren Datenreihen. Mit dem folgenden Code (unten) kann ich per Mousclick auf einen Datenpunkt der ersten Datenreihe Fahrzeuginformationen anzeigen lassen. Zu diesem Fahrzeug gehört aber noch ein weiterer Punkt aus der zweiten Datenreihe. Auch diese Information wird gleichzeitig angezeigt. Dennoch habe ich 3 Problem, die ich nicht gelöst bekomme. Ich habe eine vereinfachtes Dokument mit dem Code mal angehängt.
1. Die Datentabelle "Filtered_Data" wird mittels eines advanced filters (filter+copy) erzeugt. Dabei kann es vorkommen das eine der beiden Datenreihen keine Werte mehr für das Diagramm hat. Das führt dann immer zu Fehlermeldung, sobald man auf einen Datenpunkt der noch vorhandenen Datenreihe klilckt.
2. Eine Zeile in der Tabelle ("Filtered_Data") gehört zu einem Fahrzeug. Da ich in Wirkleichkeit eine sehr viel größere Datenbank habe kommt es auch immer mal wieder vor, dass es für ein Fahrzeug nur entweder den Wert aus der ersten Datenreihe oder den Wert aus der zweiten Datenreihe gibt. Das fürht auch zu einer Fehlermeldung und das Event wird abbgebrochen.
3. Durch das ständig neue erzeugen von neuen (gefilterten) Daten kann es vorkommen, dass die Datenbeschriftung einer Datenreihe fehlt, was beim Klicken auf das Diagramm zu Fehlermeldung führt. Kann man vielleicht die Datenbeshriftung im Event einschalten, bevor es in die With Schleife geht?
Ich hoffe ich konnte meine Probleme ausreichend gut beschreiben und ihr versteht meine Situation.
Option Explicit
Public WithEvents ch2 As Chart
Private Sub Worksheet_Activate()
Set ch2 = Tabelle4.ChartObjects(1).Chart
End Sub
Private Sub ch2_MouseDown(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, inPunkt As Integer, arrXWerte(), _
arrYWerte()
ActiveChart.GetChartElement x, y, ElementID, Arg1, Arg2
If ElementID = 3 Then
With ActiveChart.SeriesCollection(1)
.DataLabels.Delete
.Points(Arg2).ApplyDataLabels
.Points(Arg2).DataLabel.Text = " "
arrYWerte() = .Values
arrXWerte() = .XValues
For inPunkt = 1 To .Points.Count
If Worksheets("Filtered_Data").Cells(inPunkt + 3, 35) = arrXWerte(Arg2) And _
Worksheets("Filtered_Data").Cells(inPunkt + 3, 36) = arrYWerte(Arg2) Then
.Points(Arg2).DataLabel.Text = .Points(Arg2).DataLabel.Text & vbLf & _
Worksheets("Filtered_Data").Cells(inPunkt + 3, 60)
End If
Next inPunkt
End With
With ActiveChart.SeriesCollection(4)
.DataLabels.Delete
.Points(Arg2).ApplyDataLabels
.Points(Arg2).DataLabel.Text = " "
arrYWerte() = .Values
arrXWerte() = .XValues
For inPunkt = 1 To .Points.Count
If Worksheets("Filtered_Data").Cells(inPunkt + 3, 47) = arrXWerte(Arg2) And _
Worksheets("Filtered_Data").Cells(inPunkt + 3, 48) = arrYWerte(Arg2) Then
.Points(Arg2).DataLabel.Text = .Points(Arg2).DataLabel.Text & vbLf & _
Worksheets("Filtered_Data").Cells(inPunkt + 3, 60)
End If
Next inPunkt
End With
End If
End Sub