Microsoft 365 Simplification de code

[Averell1976]

Bonjour à toutes et à tous,

J'ai développé avec mes maigres connaissances en VBA une cartographie de risques sur EXCEL pour le centre de cancérologie dans lequel je travaille. Le code vba fonctionne et répond à ma demande mais il est très chronophage et je me dis qu'il y a certainement un moyen de faire plus simple, surtout si je dois faire évoluer la cartographie.
Son fonctionnement: la cartographie est formalisée dans l'onglet "CARTOGRAPHIE" et déclinée en 3 grands processus (MANAGEMENT, REALISATION, SUPPORT), puis en type de processus et en sous- processus. Pour chacun d'entre- eux, j'ai crée un bouton de commande; un clic sur chacun d'entre eux permet de visualiser la répartition de la criticité (risque à améliorer/ risque à surveiller/ risque inacceptable). Un double- clic permet de filtrer dans l'onglet "BDD" les risques renseignés et correspondant au bouton sur lequel on a double- cliqué (l'onglet "BDD" permet de renseigner et de stocker l'ensemble des risques identifiés)
Le même code est dupliqué pour chacun des boutons; hyper chronophage. Je suis sûr qu'il y a moyen de faire plus simple (for i= 1 to..... avec i = numéro du bouton par exemple). Ou faire 2 codes dans 2 modules (un pour le click, un pour le double click) et appeler le module correspondant en cliquant ou en double cliquant sur le bouton. Je ne sais pas faire mais je pense que c'est possible. Je vous met le fichier en PJ, plus simple; l'accès au code n'est pas sécurisé.

Un grand merci à vous pour votre aide

 

[Averell1976]

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..

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 .

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:
- si clic sur un bouton dont le nom est contenu en cellule (A ; i) de la feuille AIDE CODE VBA, alors:
La couleur du bouton devient celle contenue dans la cellule (C ; i) de la feuille AIDE CODE VBA,
La valeur du label1= valeur contenue en cellule (D ; i) de la feuille AIDE CODE VBA,
La valeur de la cellule B2 de la feuille RECUP DONNEES= valeur de la cellule (E ; i) de la feuille AIDE CODE VBA

- si double- clic sur un bouton dont le nom est contenu en cellule (A ; i) de la feuille AIDE CODE VBA, alors:
Le critère à filtrer dans la feuille BDD est celui contenu dans la cellule (F ; i) de la feuille AIDE CODE VBA

Comment pourrait- on transformer cette idée en code vba (fichier en PJ)

 

[Averell1976]

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:
- si clic sur un bouton dont le nom est contenu en cellule (A ; i) de la feuille AIDE CODE VBA, alors:
La couleur du bouton devient celle contenue dans la cellule (C ; i) de la feuille AIDE CODE VBA,
La valeur du label1= valeur contenue en cellule (D ; i) de la feuille AIDE CODE VBA,
La valeur de la cellule B2 de la feuille RECUP DONNEES= valeur de la cellule (E ; i) de la feuille AIDE CODE VBA

- si double- clic sur un bouton dont le nom est contenu en cellule (A ; i) de la feuille AIDE CODE VBA, alors:
Le critère à filtrer dans la feuille BDD est celui contenu dans la cellule (F ; i) de la feuille AIDE CODE VBA

Comment pourrait- on transformer cette idée en code vba (fichier en PJ)

j'ai réussi à faire un truc qui marche

 

[Rheeem]

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

Certes qu'il est possible de faire fonctionner les boutons ActiveX et les attacher aux gestionnaires d’événement , j'avais réalisé une version avant de la transformer en zones de texte le problème avec cette methode qu'elle utilise un module de classe pour attacher les éventements ce n'est comme les contrôles de formulaire ou zones de texte les shapes... qui se fait par la définition de OnAction ei donc cette solution est compliquée pour quelqu'un qui maitrise mal le VBA ..

En tout cas la voila