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

 

[sylvanu]

Bonjour Averell,

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

J'ai compté quelque 121 boucle d'attente d'une seconde : "Do: DoEvents:Loop While Now() <= fin"
A quoi servent-elles ? ( à part faire joli )
D'autant que l'item sélectionné est recopié en haut dans la case Sous-processus.
En les supprimant, vous supprimez du coup la mise en couleur d'une forme. N'y a t'il pas un moyen de faire autrement ?

 

[Averell1976]

Bonjour Averell,

J'ai compté quelque 121 boucle d'attente d'une seconde : "Do: DoEvents:Loop While Now() <= fin"
A quoi servent-elles ? ( à part faire joli )
D'autant que l'item sélectionné est recopié en haut dans la case Sous-processus.
En les supprimant, vous supprimez du coup la mise en couleur d'une forme. N'y a t'il pas un moyen de faire autrement ?

Bonjour sylvanu, merci pour ton retour. Quand tu fais un clic sur un bouton, il devient rouge pendant 1 seconde (à mon sens ergonomique pour l'utilisateur); ce temps d'attente est géré par cette boucle. Je l'ai mis dans chaque bouton car pas capable de faire plus simplement....

 

[vgendron]

Hello

tu aurais je pense intéret à refaire ta feuille "Cartographie" en utilisant des boutons de formulaire (plutot que des activeX)
auxquels tu affectes la MEME macro
et pour savoir quel critère il faut appliquer, il suffit de récuprer le nom du bouton qui a fait appel à la macro
application.caller

 

[sylvanu]

Quand tu fais un clic sur un bouton, il devient rouge pendant 1 seconde

Ca j'avais compris. 🙂
La question était plutôt :
Par souci d'ergonomie, on ralentit le système que le rend moins ergonomique.
D'où ma question : N'y a t'il pas un moyen de faire autrement ?

 

[Averell1976]

Hello

tu aurais je pense intéret à refaire ta feuille "Cartographie" en utilisant des boutons de formulaire (plutot que des activeX)
auxquels tu affectes la MEME macro
et pour savoir quel critère il faut appliquer, il suffit de récuprer le nom du bouton qui a fait appel à la macro
application.caller

Hello, merci pour ton aider. Comment récupérer le nom du bouton qui fait appel à la macro?

 

[vgendron]

Hello, merci pour ton aider. Comment récupérer le nom du bouton qui fait appel à la macro?

application.caller

 

[Averell1976]

Ca j'avais compris. 🙂
La question était plutôt :
Par souci d'ergonomie, on ralentit le système que le rend moins ergonomique.
D'où ma question : N'y a t'il pas un moyen de faire autrement ?

pardon. je trouve que ça fonctionne bien, c'est rapide; il y a sûrement un moyen de faire autrement... je ne sais juste pas comment

 

[vgendron]

tu te rends compte que tu écris TOUT ce code

Private Sub Management_Click()

Const nSec = 1
Dim fin, old, x
old = Management.BackColor
Management.BackColor = &H8000&
fin = Now() + nSec / 24 / 60 / 60

Management.BackColor = &HFF&
Label1 = "PROCESSUS"
Sheets("RECUP DONNEES").Range("A2").Value = "MANAGEMENT"
Do: DoEvents: Loop While Now() <= fin
Management.BackColor = old

End Sub

JUSTE pour mettre un mot "MANAGEMENT" dans la cellule A2 de la feuille "Recup données"

 

[vgendron]

En attendant que tu remplaces tous tes boutons ActiveX par des boutons de formulaire
ce code donnerait le meme effet pour les 3 boutons de processus

Private Sub Management_Click()
   Traitement Management.Caption 'en attendant le application.caller qui ne fonctionne pas sur des activex
End Sub

Sub Traitement(NomBouton As String)
    Sheets("RECUP DONNEES").Range("A2").Value = NomBouton
End Sub

 

[Averell1976]

tu te rends compte que tu écris TOUT ce code

Private Sub Management_Click()

Const nSec = 1
Dim fin, old, x
old = Management.BackColor
Management.BackColor = &H8000&
fin = Now() + nSec / 24 / 60 / 60

Management.BackColor = &HFF&
Label1 = "PROCESSUS"
Sheets("RECUP DONNEES").Range("A2").Value = "MANAGEMENT"
Do: DoEvents: Loop While Now() <= fin
Management.BackColor = old

End Sub

JUSTE pour mettre un mot "MANAGEMENT" dans la cellule A2 de la feuille "Recup données"

Bonjour,
Oui je me rends compte. Et pour gérer le changement de couleur du bouton pendant une seconde aussi...... c'est justement cela mon problème. Je voudrai simplifier. Mais je ne sais pas comment

 

[sylvanu]

Re,
Un simple test avec une boucle d'attente faite avec Sleep. ( sans vouloir tout casser )
Mais même avec 1ms d'attente, on voit le bouton changer de couleur à cause de la lenteur de l'outil.
J'ai fait juste une modif à l'arrache mais le principe est d'avoir pour chaque bouton cette structure :

Private Sub Acquisition_Click()
Dim old
old = Acquisition.BackColor
Acquisition.BackColor = &HFF&
Attente
Label1 = "SOUS- PROCESSUS"
Sheets("RECUP DONNEES").Range("A2").Value = "ACQUISITION"
Acquisition.BackColor = old
End Sub

Si c'est trop rapide sur votre PC il faut ajuster la valeur d'attente dans :

Sub Attente()
    Sleep 1 ' 1ms
    DoEvents
End Sub

Principe à tester avec cette PJ.

 

[vgendron]

j'ai regardé de plus près le code
dans la feuille cartographie.. TOUS les boutons n'ont qu'une seule action: mettre un texte en A2 de la feuille Recup données

1) une quantité incroyable de code inutile
2) meme les boutons sont inutiles==> tu peux mettre le texte directement dans les cellules de la feuille et il suffit de cliquer sur UNE cellule pour mettre son contenu dans A2
et ca. ca tient en UNE seule ligne de code
dans l'èvement _selectionchange de la feuille carto
if target<>"" then sheets("Recup").range("A2")=target


tu as aussi codé un _doubleclick sur chaque bouton==> pour mettre en C6 de la feuille BDD.. mais.. C6. c'est une donnée de la première ligne de la table==> tu es sur de toi ??

 

[sylvanu]

Bonsoir Vgendron,
C'est pour ça que j'ai précisé : ( sans vouloir tout casser ) 🙂
L'autre solution bien meilleure est d'utiliser des Shapes à la place des CommandButton.
Et le tout se gère en 5 lignes avec Application.caller, mais ça fait casser tout.

 

[vgendron]

hello Sylvanu

en fait.. je crois qu'il n'y a pas grand chose à casser (à part la présentation)
la feuille Cartographie peut etre remplacée par la feuille Processus dans laquelle il y a déjà tous les textes à mettre en A2
et un code _beforedoubleclic fait le boulot

suffit de déplacer les cellules pour retrouver la présentation de la cartographie
et y ajouter les calculs et graphiques

voir PJ
suffit de double cliquer sur une cellule de la feuille "Processus"