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

Benoit84

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

Benoit84

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

Discussions similaires

Statistiques des forums

Discussions
294 412
Messages
1 938 345
Membres
188 792
dernier inscrit
Mialisoa