Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Macro

mariedédé

XLDnaute Nouveau
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
 
Dernière édition:

mariedédé

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

XLDnaute Barbatruc
Re : Macro

Bonsour®
VB:
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

XLDnaute Barbatruc
Re : Macro

Bonsoir à tous

Pour le fun et parce que le marchand de sables n'est pas encore passé
VB:
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 )
 
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…