Marker probleem

[Symphysodon]

Beste forummers,

Ik heb een programma waarmee data inzichtelijk gemaakt wordt door middel grafieken. in die grafieken is het mogelijk een verticale markerlijn te plaatsen over een data punt. dit wordt geregeld met een MouseDown event

Private Sub cht_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
     Dim myX As Variant, myY As Double

     With ActiveChart
     ' Pass x & y, return ElementID and Args
          .GetChartElement x, y, ElementID, Arg1, Arg2
    ' MsgBox Arg1 & vbLf & Arg2 & vbLf & ElementID

     ' 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)
   '  MsgBox "In de klassemodule voor het verzamelen van de gegevens " & vbLf & vbLf & "Grafiek : " & .Name & vbLf & vbLf & "serienummer : " & Arg1 & vbLf & "serienaam : " & .SeriesCollection(Arg1).Name & vbLf & vbLf & "punt " & Arg2 & vbLf & "X-waarde : " & myX & vbLf & "Y-waarde : " & myY

                    MouseDownArr(0) = .Parent.Index
                    tlc = [transpose(TBL_TLC)]
                    MouseDownArr(1) = Filter([transpose(TBL_TLC)], "index_" & Format(MouseDownArr(0), "000"), 1, vbTextCompare)(0)
                    MouseDownArr(2) = Arg1
                    MouseDownArr(3) = .SeriesCollection(Arg1).Name
                    MouseDownArr(4) = Arg2
                    MouseDownArr(5) = myX
                    MouseDownArr(6) = myY

                    With Sheets("grafieken").ListObjects("TBL_GrafiekEvents")
                         r = Application.Match(MouseDownArr(1), tlc, 0)
                         If IsNumeric(r) Then .DataBodyRange.Cells(r, 1).Resize(, UBound(MouseDownArr) + 1).Value = MouseDownArr
                    End With
                    Vertel_het_een_keer

                    If Button = 2 And Arg1 = 1 Then             'rechtermuis op 1e serie
                         If IsNumeric(r) Then
                              Set c = Sheets("data").ListObjects(1).DataBodyRange.Columns(r + 3)

                              ThisWorkbook.Names.Add "Bart", c
                              c_row = Application.Small([transpose(if(bart<>"",row(bart),999))], Arg2)
                              With c.Cells(c_row - c.Row + 1).Offset(, 28) 'was 6
                                   .Value = IIf(.Value = 1, 0, 1)
                              End With
                              Hoofdprogramma
                         End If
                    End If
               End If
          End If
     End With
End Sub

Dit heeft gewerkt maar werkt nu niet meer. Het ElementID krijg ik niet meer op 3, maar is 28 wat ik ook selecteer, waarbij Arg1 en Arg2 altijd 0 zijn. In het programma kunnen toevallig wel maximaal 27 grafieken aangemaakt worden.

     ' Pass x & y, return ElementID and Args
          .GetChartElement x, y, ElementID, Arg1, Arg2

De serie collection worden weergegeven in de tabel: TBL_TLC en toen de markerfunctie nog werkte werden de resultaten van een selectie weergegeven in de tabel: TBL_GrafiekEvents. Beide tabellen staan in de sheet: Grafieken.

De tabel: TBL-TLC wordt gevoed met de Sub EnableChartEvents

Sub EnableAllChartEvents()

'Bijhouden tabel TBL_TLC (kolom x)

     Dim chtEvent As CChtEvt
     Dim tempCht As ChartObject

     Set gMyCharts = New Collection

     bgrafieken = (ActiveSheet.Index = Sheets("Grafieken").Index)     'huidig werkblad is grafieken ?
     If bgrafieken Then
          Set LO = Sheets("Grafieken").ListObjects("TBL_TLC")
          If LO.ListRows.Count Then LO.DataBodyRange.Delete
     End If
     For Each tempCht In ActiveSheet.ChartObjects
          If bgrafieken Then
               With tempCht
                    .Name = "Grafiek_" & Format(.TopLeftCell.Row, "0000") & "_Index_" & Format(.Index, "000") & "_" & .TopLeftCell.Address
                    LO.ListRows.Add.Range.Cells(1).Value = .Name
               End With
          End If
          Set chtEvent = New CChtEvt
          Set chtEvent.cht = tempCht.Chart
          gMyCharts.Add chtEvent, CStr(gMyCharts.Count + 1)
     Next

     If bgrafieken Then LO.Range.Sort LO.Range.Range("A1"), Header:=xlYes

End Sub

Deze code en zo ook de Sub: Vertel_het_een_keer (die ook in de MouseDown gebruikt wordt) staan in de module: ModuleEventsGrafieken.

Ik hoop dat iemand me kan helpen.

Mvg
Marco

 

[AccessGuru]

Leuk bestandje, maar waar zit die code? Of is het de bedoeling dat we die zelf vinden? Het is nog geen Pasen .

 

[Symphysodon]

Ik ben te vroeg :d

De cht_MouseDown zit in de klassenmodules: CChtEvt

 

[AccessGuru]

En hoe zou de procedure moeten werken? Want ik snap je methodiek ook niet. Als die er al is

 

[Symphysodon]

Hier https://www.oreilly.com/library/view/programming-excel-with/0596007663/re1064.html staat iets over het gebruik getchartelement, misschien wordt het dan wat duidelijker. Op het moment je in een grafiek met je muis een datapunt aanklikt worden de datagegevens weergegeven in de labeltabel naast de grafiek en komt er een mangenta markerlijn over het geselecteerde datapunt. Dat zou het resultaat moeten zijn.

In de link https://www.mrexcel.com/board/threads/vba-return-datapoint-on-embedded-chart.553994/ staat de werking beschreven en misschien ook de oplossing, ik kan hem helaas niet goed genoeg volgen. Misschien heeft het iets met de index van de chart te maken die niet klopt omdat excel zelf een lijst aan maakt met de verschillende grafieken (Chartobjects) in de volgorde van hun aanmaak.

Op het moment je met de muis een grafiek selecteert wordt de cht_MouseDown in de klassenmodule CChtEvt al geactiveerd. Het probleem is dat wanneer je op een datapunt klikt het ElementID niet overeen komt met xlSeries of xlDataLabel. xlSeries=3 en ElementID is 28. Dit is wat ik tot zover kan volgen. Het vullen met de indexnummers in TBL_GrafiekEvents loopt niet en daarom werkt het niet meer denk ik.

 

[Symphysodon]

Iemand?

In de bijlage een bijgewerkte versie. In grafiek 1 (DataGrf_1) werkt de markerlijn nu wel maar het disabelen van een datapunt (rechtermuisknop) niet. De andere grafieken geven als ElementID 28 en dat moet 3 zijn.

 

[Symphysodon]

Misschien kan cow18 er eens in gaan duiken.

Het vreemde blijft dat na het selecteren van een grafiek de ElementID 28 (remark xlNothing) blijft.

 

[Symphysodon]

Ik krijg het nog steeds niet voor elkaar. In de bijlage een oude versie die nog wel werkt. Het is een versie met 5 grafieken.
Als ik de laatste 26 grafieken delete en kopieer vervolgens de eerste grafiek 26 keer dan lijkt het te werken. Alleen dit heb ik al een keer eerder uitgevoerd en de werking was helaas van korte duur.

Ik hoop dat iemand kan helpen