Créer plusieurs boutons qui exécute la même macro

pehrs · 16 Septembre 2022

Bonjour à tous, je suis débutant en VBA et j'aimerais créer une liste interactive sur excel. En somme, j'ai une liste de chose à faire et je voudrais créer des boutons toggle OUI/ Non que je pourrais mettre à coté pour voir comment j'avance dans ma liste de chose à faire. J'ai réussi à coder un bouton (c'est un bouton toggle qui affiche oui et non après avoir cliqué dessus, et vice-versa), seulement maintenant j'aimerais pouvoir le dupliquer (une vingtaine de fois) sans tout avoir à me farcir à la main. J'ai mis le code juste en dessous.
Auriez vous des conseils?
Merci d'avance

VB:

Private Sub ToggleButton1_Click()

 If ToggleButton1 Then
  ToggleButton1.Caption = "Oui"
  ToggleButton1.BackColor = &HFF&
 
 Else
  ToggleButton1.Caption = "Non"
  ToggleButton1.BackColor = &H80FF80
 
 End If
End Sub

yal · 16 Septembre 2022

Bonjour
Une proposition

pehrs · 16 Septembre 2022

Hello yal, merci pour ta proposition mais je ne maitrise pas du tout les user forms donc je ne comprends pas bien ce que tu as fait.
Pour clarifier j'aimerais créer plusieurs boutons bien séparer (que je pourrais ensuite déplacer à ma convenance) donc idéalement sans UserForm.
L'idéal serait d'avoir une macro qui lorsque je sélectionne une cellule et que je la lance, me créé un bouton dans cette cellule avec le code que j'ai donné un peu plus haut.
je ne sais pas si c'est possible.

Pour être encore plus clair, j'aimerais remplacer les listes par des boutons à peu près au même endroit dans le fichier exemple.

yal · 16 Septembre 2022

Voilà qui est déjà beaucoup plus clair

sylvanu · 16 Septembre 2022

Bonjour Pehrs,Yal,
Si j'ai bien compris, il est inutile de mettre des listes déroulantes, cela peut se faire en automatique.
Un appui écrit Oui, un autre écrit Non.
Voir PJ avec :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [C:C]) Is Nothing Then
        If Cells(Target.Row, Target.Column - 1) <> "" Then
            If Target = "Non" Or Target = "" Then
                Target = "Oui"
                Range(Target.Address).Interior.Color = RGB(0, 255, 0)
            Else
                Target = "Non"
                Range(Target.Address).Interior.Color = RGB(255, 0, 0)
            End If
            Cells(Target.Row, Target.Column - 1).Select
        End If
    End If
Fin:
End Sub

yal · 16 Septembre 2022

Bon ben j'allais poster la même chose.

pehrs · 16 Septembre 2022

sylvanu à dit:

Bonjour Pehrs,Yal,
Si j'ai bien compris, il est inutile de mettre des listes déroulantes, cela peut se faire en automatique.
Un appui écrit Oui, un autre écrit Non.
Voir PJ avec :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [C:C]) Is Nothing Then
        If Cells(Target.Row, Target.Column - 1) <> "" Then
            If Target = "Non" Or Target = "" Then
                Target = "Oui"
                Range(Target.Address).Interior.Color = RGB(0, 255, 0)
            Else
                Target = "Non"
                Range(Target.Address).Interior.Color = RGB(255, 0, 0)
            End If
            Cells(Target.Row, Target.Column - 1).Select
        End If
    End If
Fin:
End Sub

C'est exactement ce qu'il me fallait je te remercie!!
Si ça ne te dérange pas est-ce-que tu pourrais me dire quelle fonction tu utilises pour détecter le clic et plus généralement m'expliquer un peu comment tout ça fonctionne? Ce serait super sympa, merci d'avance!

pehrs · 16 Septembre 2022

yal à dit:
Bon ben j'allais poster la même chose.

Merci d'avoir pris le temps de me répondre!

sylvanu · 16 Septembre 2022

Re,
Il existe un type de macros spécifiques appelées événementielles qui se déclenchent automatiquement sur ... un événement.
Il faut cependant :
1- Que leur nom soit spécifique
2- Qu'elle soit placée obligatoirement dans la feuille considérée, et non dans un module.
Déclencher une macro sur un clic sur une cellule est appelée Sub Worksheet_SelectionChange et est placée ( dans ce fichier ) dans Feuil1.
( la liste des macros événementielles se trouve ici . )
En PJ la même chose que précédemment mais commentée ligne par ligne.

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' On arrive automatiquement ici lorsqu'on clique sur une cellule
' La cellule cliquée s'appelle ici Target ( nom arbitraire )
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub                                   ' Si plusieurs cellules sélectionnées, on sort
    If Not Intersect(Target, [C:C]) Is Nothing Then                     ' Si la cellule cliquée est en colonne C
        If Cells(Target.Row, Target.Column - 1) <> "" Then              ' Si la même cellule en colonne B est non vide
            If Target = "Non" Or Target = "" Then                       ' Si la valeur est vide ou Non
                Target = "Oui"                                          ' On met Oui
                Range(Target.Address).Interior.Color = RGB(0, 255, 0)   ' On met la cellule en vert
            Else                                                        ' Sinon
                Target = "Non"                                          ' On met Non
                Range(Target.Address).Interior.Color = RGB(255, 0, 0)   ' On met la cellule en rouge
            End If
            Cells(Target.Row, Target.Column - 1).Select                 ' On selectionne la même cellule en colonne B
        End If
    End If
Fin:
' NB :
' 1- J'utilise RBG pour la couleur par habitude car plus précis, on pourrait utiliser Index
' 2- Il faut finir en selectionnant une autre cellule car sinon on ne peut pas cliquer deux fois sur la même cellule
End Sub

pehrs · 16 Septembre 2022

sylvanu à dit:

Re,
Il existe un type de macros spécifiques appelées événementielles qui se déclenchent automatiquement sur ... un événement.
Il faut cependant :
1- Que leur nom soit spécifique
2- Qu'elle soit placée obligatoirement dans la feuille considérée, et non dans un module.
Déclencher une macro sur un clic sur une cellule est appelée Sub Worksheet_SelectionChange et est placée ( dans ce fichier ) dans Feuil1.
( la liste des macros événementielles se trouve ici . )
En PJ la même chose que précédemment mais commentée ligne par ligne.

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' On arrive automatiquement ici lorsqu'on clique sur une cellule
' La cellule cliquée s'appelle ici Target ( nom arbitraire )
On Error GoTo Fin
    If Target.Count > 1 Then Exit Sub                                   ' Si plusieurs cellules sélectionnées, on sort
    If Not Intersect(Target, [C:C]) Is Nothing Then                     ' Si la cellule cliquée est en colonne C
        If Cells(Target.Row, Target.Column - 1) <> "" Then              ' Si la même cellule en colonne B est non vide
            If Target = "Non" Or Target = "" Then                       ' Si la valeur est vide ou Non
                Target = "Oui"                                          ' On met Oui
                Range(Target.Address).Interior.Color = RGB(0, 255, 0)   ' On met la cellule en vert
            Else                                                        ' Sinon
                Target = "Non"                                          ' On met Non
                Range(Target.Address).Interior.Color = RGB(255, 0, 0)   ' On met la cellule en rouge
            End If
            Cells(Target.Row, Target.Column - 1).Select                 ' On selectionne la même cellule en colonne B
        End If
    End If
Fin:
' NB :
' 1- J'utilise RBG pour la couleur par habitude car plus précis, on pourrait utiliser Index
' 2- Il faut finir en selectionnant une autre cellule car sinon on ne peut pas cliquer deux fois sur la même cellule
End Sub

C'est super clair merci beaucoup!

Créer plusieurs boutons qui exécute la même macro

pehrs

XLDnaute Nouveau

yal

XLDnaute Occasionnel

Pièces jointes

pehrs

XLDnaute Nouveau

Pièces jointes

yal

XLDnaute Occasionnel

sylvanu

XLDnaute Barbatruc

Pièces jointes

yal

XLDnaute Occasionnel

pehrs

XLDnaute Nouveau

pehrs

XLDnaute Nouveau

sylvanu

XLDnaute Barbatruc

Pièces jointes

pehrs

XLDnaute Nouveau

Discussions similaires