Microsoft 365 Transformer des cellule en boutons

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

jalaba

XLDnaute Nouveau
Bonjour;
Je dois crée une grille d'audite et j'aimerais que les cellules soit des boutons sélectionnables calculant un score dans la case résultats.
Conforme: 3
Non conforme 0
Non évalué: 1
Non applicable 2
 

Pièces jointes

Bonjour Jalaba,
Je ne pense pas qu'il soit utile de créer des boutons. Voir en PJ.
Quand on clique sur une cellule contenant un des mots clé elle se met en vert et actualise Résultat.
Avec :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Fin
    If Target.Count > 2 Then Exit Sub
    If Not Intersect(Target, Range("B1:E1000")) Is Nothing Then
        couleur = RGB(200, 225, 180) ' à modifier si besoin
        c = Target  ' transfert dans array car cellules fusionnées
        Range(Cells(Target.Row, "B"), Cells(Target.Row, "E")).Interior.Color = vbWhite
        Select Case c(1, 1)
            Case "Conforme"
                Target.Interior.Color = couleur
                Cells(Target.Row, "F") = 3
            Case "Non conforme"
                Target.Interior.Color = couleur
                Cells(Target.Row, "F") = 0
            Case "Non évalué"
                Target.Interior.Color = couleur
                Cells(Target.Row, "F") = 1
            Case "Non applicable"
                Target.Interior.Color = couleur
                Cells(Target.Row, "F") = 2
        End Select
    End If
Fin:
End Sub
 

Pièces jointes

Bonjour Jalaba,
Je ne pense pas qu'il soit utile de créer des boutons. Voir en PJ.
Quand on clique sur une cellule contenant un des mots clé elle se met en vert et actualise Résultat.
Avec :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Fin
    If Target.Count > 2 Then Exit Sub
    If Not Intersect(Target, Range("B1:E1000")) Is Nothing Then
        couleur = RGB(200, 225, 180) ' à modifier si besoin
        c = Target  ' transfert dans array car cellules fusionnées
        Range(Cells(Target.Row, "B"), Cells(Target.Row, "E")).Interior.Color = vbWhite
        Select Case c(1, 1)
            Case "Conforme"
                Target.Interior.Color = couleur
                Cells(Target.Row, "F") = 3
            Case "Non conforme"
                Target.Interior.Color = couleur
                Cells(Target.Row, "F") = 0
            Case "Non évalué"
                Target.Interior.Color = couleur
                Cells(Target.Row, "F") = 1
            Case "Non applicable"
                Target.Interior.Color = couleur
                Cells(Target.Row, "F") = 2
        End Select
    End If
Fin:
End Sub
Merci beaucoup pour votre aide
Bonjour Jalaba,
Je ne pense pas qu'il soit utile de créer des boutons. Voir en PJ.
Quand on clique sur une cellule contenant un des mots clé elle se met en vert et actualise Résultat.
Avec :
VB:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error GoTo Fin
    If Target.Count > 2 Then Exit Sub
    If Not Intersect(Target, Range("B1:E1000")) Is Nothing Then
        couleur = RGB(200, 225, 180) ' à modifier si besoin
        c = Target  ' transfert dans array car cellules fusionnées
        Range(Cells(Target.Row, "B"), Cells(Target.Row, "E")).Interior.Color = vbWhite
        Select Case c(1, 1)
            Case "Conforme"
                Target.Interior.Color = couleur
                Cells(Target.Row, "F") = 3
            Case "Non conforme"
                Target.Interior.Color = couleur
                Cells(Target.Row, "F") = 0
            Case "Non évalué"
                Target.Interior.Color = couleur
                Cells(Target.Row, "F") = 1
            Case "Non applicable"
                Target.Interior.Color = couleur
                Cells(Target.Row, "F") = 2
        End Select
    End If
Fin:
End Sub
Merci de votre aide
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

  • Question Question
Microsoft 365 Probléme VBA
Réponses
8
Affichages
213
  • Question Question
Microsoft 365 Bouton VBA
Réponses
4
Affichages
354
Réponses
8
Affichages
623
Réponses
8
Affichages
507
Retour