Microsoft 365 Transformer des cellule en boutons

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

  • trame audit curage.xlsx
    21.5 KB · Affichages: 9

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

  • trame audit curage (1).xlsm
    31.5 KB · Affichages: 4

jalaba

XLDnaute Nouveau
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
 

Discussions similaires

Réponses
4
Affichages
168
Réponses
8
Affichages
363

Statistiques des forums

Discussions
311 721
Messages
2 081 929
Membres
101 843
dernier inscrit
Thaly