Microsoft 365 Coloriage d'une cellule en fonction d'une valeur

[Benoit84]

Bonjour

J'ai un code qui permet de donner une couleur en fonction de la valeur trouvée dans la cellule.
Ce code fonctionne correctement lorsqu'on renseigne la cellule et que l'on valide celle-ci par "entrer" ou qu'on copie une cellule sur une autre cellule.

En revanche quand je copie une valeur dans plusieurs cellules à la fois, celles-ci ne sont pas validées par entrer et ne se mettent pas à jour avec la couleur définie.

Pouvez-vous m'aider à adapter mon code ?
Merci d'avance

Private Sub Worksheet_Change(ByVal Target As Range)

Chaine = Target.Value

With Target.Interior

On Error Resume Next
'code

If Err <> 0 Then MsgBox Err.Description

If InStr(Chaine, "moi") Then .ColorIndex = 22
If InStr(Chaine, "toi") Then .ColorIndex = 40
If InStr(Chaine, "eux") Then .ColorIndex = 40

If Chaine = "" Then .ColorIndex = 35


End With
End Sub


Cordialement
Benoit

 

[sylvanu]

Bonjour Benoît,
pourquoi faire du VBA alors qu'une simple MFC remplirait la même fonction ?

 

[Benoit84]

Bonjour,

Oui effectivement pourquoi faire compliquer quand on peut faire simple voir très simple...
Je n'y avais pas songé à la mise en forme.
Merci

 

[Benoit84]

Bonjour
Je reprends mon post, car en fait le vba est indispensable, je viens de voir à l'usage que les différents utilisateurs font des copie coller de cellules ce qui augmente le nombre de règles dans la feuille.
Je dois donc supprimer toutes les règles et penser à un code.

J'ai modifier le "Worksheet_Change(ByVal Target As Range)" par :

"Worksheet_SelectionChange"

Dans mon code je voudrais désigner 3 zones sur lequel cette règle de change s'applique :
j'ai créé 3 zones dans ma feuille, nommées : tableau1, tableau2, tableau3,
je ne veux pas que le change soit sur les autres cellule

Ne maîtrisant pas le vba, pouvez vous m'aider ?


Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Chaine = Target.Value

Dim plage As Range
Set plage = Range("tableau1")
Set plage = Range("tableau2")
Set plage = Range("tableau3")

With Target.Interior
On Error Resume Next

If Err <> 0 Then MsgBox Err.Description

If InStr(Chaine, "atur") Then .ColorIndex = 22
If InStr(Chaine, "dpt") Then .ColorIndex = 40
If InStr(Chaine, "amme") Then .ColorIndex = 40

If Chaine = "" Then .ColorIndex = 35

End With
End sub