Macro

[mariedédé]

Bonjour,

j'ai fait une macro en prenant plusieurs idée sur le site, mais j'ai 2 problèmes avec :
1 j'aimerai metter la police en blanc pour les couleurs foncées .
2 quand j'efface une celleulle excel m'afficjhe un message d'erreur

voici la marco :
Private Sub Worksheet_Change(ByVal Target As Range)
Chaine = Target.Value
With Target.Interior
If InStr(Chaine, "RH") Then .ColorIndex = 15
If InStr(Chaine, "TP") Then .ColorIndex = 48
If InStr(Chaine, "cr") Then .ColorIndex = 4
If InStr(Chaine, "avi") Then .ColorIndex = 6
If InStr(Chaine, "vian") Then .ColorIndex = 7
If InStr(Chaine, "diet") Then .ColorIndex = 10
If InStr(Chaine, "pf") Then .ColorIndex = 12
If InStr(Chaine, "lég") Then .ColorIndex = 43
If InStr(Chaine, "RTT") Then .ColorIndex = 39
If InStr(Chaine, "xxx") Then .ColorIndex = 40
If InStr(Chaine, "AM") Then .ColorIndex = 22

End With
End Sub

merci à vous

 

[Modeste geedee]

Re : Macro

Bonsour®

Target.Font.ColorIndex= vbwhite


pas de message d'erreur chez moi ...

 

[mariedédé]

Re : Macro

Bonsoir Modeste geedee,

mais où dois-je rajouter cette ligne ?

merci d'
avance

 

[Modeste geedee]

Re : Macro

Bonsour®

quand tu metter un Target.Interior.ColorIndex "foncé"

 

[mariedédé]

Re : Macro

Bonsoir,

Malgré l'aide de Modeste geedee, je n'arrive pas à terminer le code VBA ci-dessous.
j'aimerai mettre la police en blanc pour les couleurs foncées .
et quand j'efface une cellule elle redevienne à sa couleur d'origine.

Merci d'avance à ceux qui pourront m'aider:

"
Private Sub Worksheet_Change(ByVal Target As Range)
Chaine = Target.Value
With Target.Interior
If InStr(Chaine, "RH") Then .ColorIndex = 15
If InStr(Chaine, "TP") Then .ColorIndex = 48
If InStr(Chaine, "CR") Then .ColorIndex = 4
If InStr(Chaine, "AVI") Then .ColorIndex = 6
If InStr(Chaine, "VIAN") Then .ColorIndex = 7
If InStr(Chaine, "DIET") Then .ColorIndex = 10
If InStr(Chaine, "PF") Then .ColorIndex = 12
If InStr(Chaine, "LEG") Then .ColorIndex = 43
If InStr(Chaine, "RTT") Then .ColorIndex = 39
If InStr(Chaine, "xxx") Then .ColorIndex = 40
If InStr(Chaine, "AM") Then .ColorIndex = 22

End With
End Sub"

 

[Modeste geedee]

Re : Macro

Bonsour®

Private Sub Worksheet_Change(ByVal Target As Range)
 Chaine = Target.Value
 With Target
' ----------remise à l'état standard (style Normal)
 .Font.Colorindex= xlAutomatic
 .Interior.Color = xlNone
'-----------
 If InStr(Chaine, "RH") Then .Interior.ColorIndex = 15
 If InStr(Chaine, "TP") Then .Interior.ColorIndex = 48: .Font.Color = vbWhite
 If InStr(Chaine, "CR") Then .Interior.ColorIndex = 4: .Font.Color = RGB(255, 0, 0)
 If InStr(Chaine, "AVI") Then .Interior.ColorIndex = 6: .Font.Color = vbMagenta
 If InStr(Chaine, "VIAN") Then .Interior.ColorIndex = 7: .Font.Color = vbYellow
 If InStr(Chaine, "DIET") Then .Interior.ColorIndex = 10: .Font.Color = vbWhite
 If InStr(Chaine, "PF") Then .Interior.ColorIndex = 12: .Font.Color = RGB(255, 255, 255)
 If InStr(Chaine, "LEG") Then .Interior.ColorIndex = 43: .Font.Color = vbMagenta
 If InStr(Chaine, "RTT") Then .Interior.ColorIndex = 39: .Font.Color = vbYellow
 If InStr(Chaine, "xxx") Then .Interior.ColorIndex = 40: .Font.ColorIndex = 10
 If InStr(Chaine, "AM") Then .Interior.ColorIndex = 22: .Font.Color = vbBlue

 End With
 End Sub

 

[Staple1600]

Re : Macro

Bonsoir à tous

Pour le fun et parce que le marchand de sables n'est pas encore passé

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TVALS, TCOLS
TVALS = Array("RH", "TP", "CR", "AVI", "VIAN", "DIET")
TCOLS = _
        Array(Array(15, vbBlack), Array(48, vbWhite), _
        Array(4, RGB(255, 0, 0)), Array(6, vbMagenta), _
        Array(7, vbYellow), Array(10, vbWhite))
On Error Resume Next
With Target
    .Interior.ColorIndex = TCOLS(Application.Match(.Value, TVALS, 0) - 1)(0)
    .Font.Color = TCOLS(Application.Match(.Value, TVALS, 0) - 1)(1)
End With
End Sub

PS: Il faut finir de remplir les Arrays sur le même principe
(enfin si et seulement si cet amusement vbaiste trouve preneur auprés d'un lecteur de ce fil ou du demandeur )

 

[mariedédé]

Re : Macro

Bonsoir,

Merci à vous deux, c’est impeccable.

Bon W-E