Microsoft 365 Simplification de code

Rheeem à dit:

Le double click n'est pas géré nativement par les zonzq de text les qhshape et les contoles de formulaires seule les controles ActiveX les gèrent ,il faut trouver une astuce pour créer un pseudo Dbl click en calculant l'écart entre deux clicks successifs et les convertir à l evenement Dbl clicks..

Code:

Private Function ClickDetect() As String
 Static LastHit As Single
 Static Listening As Boolean
 Dim w As Single
 If Not Listening Then
    Listening = True
    w = Timer
    While Timer - w < 0.6
      DoEvents
    Wend
    Listening = False
    If Timer - LastHit > 0.6 Then
      ClickDetect = "Clk"
    Else
      ClickDetect = "Dbl"
    End If
 End If
 LastHit = Timer
End Function

Sub GlobalClick()
Dim mAction As String
mAction = ClickDetect
 
If mAction = "" Then Exit Sub ' un clique mort

Dim Indice As Long, Btn As Object
Dim Cfg, nName As String
Set Cfg = Range("BtnConfig")
nName = Application.Caller
For I = 1 To Cfg.Rows.Count
    If Cfg(I, 1) = nName Then
       Indice = I
       Exit For
     End If
Next

If Indice = 0 Then
  MsgBox "Nom introuvable " & nName
  Exit Sub
End If

Set Btn = Worksheets("CARTOGRAPHIE").Shapes(nName)
If mAction = "Clk" Then
    'effet visuel
    Const nSec = 1#
    Dim fin, old, x
    old = Btn.Fill.ForeColor.RGB
    Btn.Fill.ForeColor.RGB = Cfg(Indice, 2).Interior.Color
    fin = Now() + nSec / (24# * 60# * 60#)
    Btn.Fill.ForeColor.RGB = &HFF&
    Worksheets("CARTOGRAPHIE").Label1 = Cfg(Indice, 3)
    Sheets("RECUP DONNEES").Range("A2").Value = Cfg(Indice, 4)
    Do: DoEvents: Loop While Now() <= fin
    Btn.Fill.ForeColor.RGB = old
Else ' Dbl doubleClick
    'filtrage ...
    If Cfg(Indice, 6) = "" Then Exit Sub
  
    Dim ws As Worksheet, rng
    Set ws = ThisWorkbook.Sheets("BDD")
    
    If ws.AutoFilterMode Then
       ws.AutoFilterMode = False
    End If
    ' Appliquer le filtre pour ""
    Set rng = ws.Range(Cfg(Indice, 5))
     rng.AutoFilter Field:=rng.Column, Criteria1:=Cfg(Indice, 6)
     ws.Activate
End If

End Sub

J'ai fixé l'écart à 0.6 s car j'utilse un laptop et sans souris et un double click est plus long à détecter tu peux l'ajuster selon le besoin .

Cliquez pour agrandir...

Re, merci pour ton aide Rheeem et merci pour votre aide à tous. Mais si je reste têtu et que je veux malgré tout essayer de fonctionner avec des boutons de contrôle ActiveX, est- ce qu'il n'est pas possible de coder un truc du genre: pour chaque bouton de contrôle contenu dans la feuille CARTOGRAPHIE

Cliquez pour agrandir...