Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Userform
BildScreenshot zu Userform Userform-Seite mit Beispielarbeitsmappe aufrufen
Informationen und Beispiele zum Thema Label
BildScreenshot zu Label Label-Seite mit Beispielarbeitsmappe aufrufen

VBA Diagramm MousDown mit mehreren Datenreihen

Betrifft: VBA Diagramm MousDown mit mehreren Datenreihen von: Matthias
Geschrieben am: 18.07.2013 13:57:17

Hallo Forum,

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
https://www.herber.de/bbs/user/86445.xlsm

  

Betrifft: AW: VBA Diagramm MousDown mit mehreren Datenreihen von: fcs
Geschrieben am: 18.07.2013 16:26:32

Hallo Mathias,

den Fehler 3 (fehlende Datenpunktbeschriftung) konnte ich per Testen finden.
Die Probleme 1 und 2 kann ich nur vermuten.

Ich hab in dein Makro mal eine entsprechende Fehler-Behandlung eingebaut.
Wenn die angezeigten Fehlernummern bekannt sind, dann kann man die entsprechenden Case Zeilen und Fortsetzungs-Zeilen etwas genauer festlegen. Dazu sind z.Zt. noch MsgBox enthalten, die du später löschen oder zu Kommentar machen kannst.

Gruß
Franz

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()
  Dim intFehler As Integer
 On Error GoTo Fehler
 ActiveChart.GetChartElement x, y, ElementID, Arg1, Arg2
 If ElementID = 3 Then
    intFehler = 1
    With ActiveChart.SeriesCollection(1)
        .DataLabels.Delete
        intFehler = 2
        .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
Fehler03:
    intFehler = 3
    With ActiveChart.SeriesCollection(4)
        .DataLabels.Delete
        intFehler = 4
        .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
Fehler04:
 End If
Fehler:
 With Err
  Select Case .Number
    Case 0 'alles ok
    Case -2147467259 'DataLabel Count-Eigenschaft kann nicht zugeordnet werden
      'fängt Fehler ab bei .DataLabels.Delete, wenn keine Labels vorhanden
      Resume Next
    Case Else
      Select Case intFehler
        Case 1, 2
          MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description 'zu Kommentar machen
          Resume Fehler03
        Case 3, 4
          MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description 'zu Kommentar machen
          Resume Fehler04
      Else
        MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
      End If
  End Select
 End With
End Sub



  

Betrifft: AW: VBA Diagramm MousDown mit mehreren Datenreihen von: Matthias
Geschrieben am: 19.07.2013 12:22:03

Hallo Franz,

danke für deine Hilfe. Mir ist leider noch nicht ganz bewusst was die Fehler-Behanflung bezwecken soll. Geht es dabei darum, statt einer Fehlermeldung in einer Case SChleife zu landen und dort den Fehler dann zu beheben??? Sorry, aber für mich ist das Neuland.

Ausserdem fehlt in deinem Code irgendwie ein IF. Ich bekomme bei deem letzten ELSE in die Fehlermeldung ,dass ein IF fehlt. Muss ich das Else gegen CASE ELSE und das END IF gegen END SELECT tauschen?

Gruß
Matthias


  

Betrifft: AW: VBA Diagramm MousDown mit mehreren Datenreihen von: fcs
Geschrieben am: 19.07.2013 12:58:26

Hallo Matthias,

  • Muss ich das Else gegen CASE ELSE und das END IF gegen END SELECT tauschen?

  • Ja, da hatte ich zum Schluss noch etwas geändert und dann nicht mehr getestet.

    Excel gibt bei fast jedem Fehler in einem Makro eine Meldung aus und unterbricht den Code an der Zeile in der der Fehler auftritt. In dem Err-Objekt werden dazu die entsprechendne Informationen gespeichert (u.a. die Nummer des Fehlers) und können auch im Code verarbeitte werden.

    Mit einer Zeile
    On Error .....
    kann man Steuern, was Excel nach einem Fehler machen soll.
    Dazu hab ich das Konstrukt am Ende der Prozedur eingebaut.

    Da bei dir in den For-Next-Schleifen der gleiche Fehler auftreten kann hab ich zusätzlich die Variable intFehler eingebaut, die wenn das Makro abgearbeitet wird unterschiedliche Werte zugewiesen bekommt. So kann man in der Fehlerprüfung feststellen, in welchem Code-Abschnitt der Makro-Fehler aufgetreten ist, und festlegen wo bei einem Fehler die Ausführung des Makros fortgesetzt werden soll.
    Dies kann in der nächsten Zeile sein (Resume Next) oder an einer bestimten Sprungadresse (Resume Sprungadresse).

    Ich hab das jetzt mal provisorisch festgelegt, wie es mir logisch erscheint.
    Wenn du die Fehlernummern der anderen Fehler kennst, dann kann eine entsprechende Case-Zeile für die Fehler-Nummer eingebaut werden und die Fehlerbehandlung verfeinert werden.

    Falls du da was konkreteres haben möchtes, dann wäre wichtig zu wissen, in welchen Zeilen bisher ein Fehler getretten ist und welche Fehler-Nr. angezeigt wurde.

    Gruß
    Franz


     

    Beiträge aus den Excel-Beispielen zum Thema "VBA Diagramm MousDown mit mehreren Datenreihen"