Microsoft 365 Probléme VBA

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éer un tableau d'enregistrement des non conformité et j'aimerais créer des bouton avec vba en colonne t:10,u :10 et v 10 (1 vert,2 orange,3 rouge)
J'ai enregistré cette vba mais elle ne fonctionne pas .
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim RangeToCheck As Range
Set RangeToCheck = Range("T10:V10")
If Not Intersect(Target, RangeToCheck) Is Nothing Then
Application.EnableEvents = False
For Each Cell In Intersect(Target, RangeToCheck)
Select Case Cell.Value
Case 1
Cell.Interior.Color = RGB(0, 176, 80)
Case 2
Cell.Interior.Color = RGB(255, 165, 0)
Case 3
Cell.Interior.Color = RGB(255, 0, 0)
Case Else
Cell.Interior.ColorIndex = xlNone
End Select
Next Cell
Application.EnableEvents = True
End If
End Sub
Autre chose j'aimerai créé une feuille avec des graphique par client mais je n'y arrive pas merci pour votre aide
 

Pièces jointes

Bonjour Jalaba,
Utilisez la balise pour le code ( à droite de GIF ) c'est plus clair.
Ensuite expliquez ce que vous voulez faire, sinon vous aurez une réponse au pif. Comme celle ci :
Je suppose que si on clique sur 1,2 ou 3 on efface les couleurs des trois et on met la couleur sur la cellule cliquée ?
Si c'est ça, un essai en 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, [T10:V352]) Is Nothing Then
        L = Target.Row: C = Target.Column
        Range("T" & L & ":V" & L).Interior.Color = xlNone
        Select Case C
            Case 20: Cells(L, C).Interior.Color = RGB(0, 176, 80)
            Case 21: Cells(L, C).Interior.Color = RGB(255, 165, 0)
            Case 22: Cells(L, C).Interior.Color = RGB(255, 0, 0)
        End Select
    End If
Fin:
End Sub
 

Pièces jointes

Bonjour Jalaba,
Utilisez la balise pour le code ( à droite de GIF ) c'est plus clair.
Ensuite expliquez ce que vous voulez faire, sinon vous aurez une réponse au pif. Comme celle ci :
Je suppose que si on clique sur 1,2 ou 3 on efface les couleurs des trois et on met la couleur sur la cellule cliquée ?
Si c'est ça, un essai en 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, [T10:V352]) Is Nothing Then
        L = Target.Row: C = Target.Column
        Range("T" & L & ":V" & L).Interior.Color = xlNone
        Select Case C
            Case 20: Cells(L, C).Interior.Color = RGB(0, 176, 80)
            Case 21: Cells(L, C).Interior.Color = RGB(255, 165, 0)
            Case 22: Cells(L, C).Interior.Color = RGB(255, 0, 0)
        End Select
    End If
Fin:
End Sub
Merci beaucoup 🙂
 
Bonjour Jalaba,
Utilisez la balise pour le code ( à droite de GIF ) c'est plus clair.
Ensuite expliquez ce que vous voulez faire, sinon vous aurez une réponse au pif. Comme celle ci :
Je suppose que si on clique sur 1,2 ou 3 on efface les couleurs des trois et on met la couleur sur la cellule cliquée ?
Si c'est ça, un essai en 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, [T10:V352]) Is Nothing Then
        L = Target.Row: C = Target.Column
        Range("T" & L & ":V" & L).Interior.Color = xlNone
        Select Case C
            Case 20: Cells(L, C).Interior.Color = RGB(0, 176, 80)
            Case 21: Cells(L, C).Interior.Color = RGB(255, 165, 0)
            Case 22: Cells(L, C).Interior.Color = RGB(255, 0, 0)
        End Select
    End If
Fin:
End Sub
merci
 
- 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 worksheet_change
Réponses
29
Affichages
250
Réponses
4
Affichages
147
Réponses
7
Affichages
106
Réponses
1
Affichages
322
Retour