Les conditions en VBA

Bonjour, je cherche le moyen de changer le couleur de police sous conditions

si a1<100 - noir

si a1compris entre 100 et 200 - vert

si a1compris entre 200 et 300 - magenta

si a1compris entre 300 et 400 - bleu

si a1>400 - rouge

en VBA

Merci à vous

Bonjour,

A placer dans la feuille concernée

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
    If Range("A1").Value < 100 Then Target.Font.Color = RGB(0, 0, 0)
    If Range("A1").Value >= 100 And Range("A1").Value < 200 Then Target.Font.Color = RGB(0, 255, 0)
    If Range("A1").Value >= 200 And Range("A1").Value < 300 Then Target.Font.Color = RGB(112, 48, 160)
    If Range("A1").Value >= 300 And Range("A1").Value < 400 Then Target.Font.Color = RGB(0, 0, 255)
    If Range("A1").Value >= 400 Then Target.Font.Color = RGB(255, 0, 0)
  End If
End Sub

Bonjour,

Moi je l'aurai vu plutôt comme ça :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim C
  If Not Application.Intersect(Target, Range("A1")) Is Nothing Then
  Select Case [A1]
  Case Is < 100: C = RGB(0, 0, 0)
   Case Is < 200: C = RGB(0, 150, 0)      'vert
    Case Is < 300: C = RGB(200, 0, 255)   'magenta
    Case Is < 400: C = RGB(0, 0, 255)     'bleu
    Case Else: C = RGB(255, 0, 0)         'rouge
    End Select
    Target.Font.Color = C
  End If
End Sub

A+

Bonjour,

Voici un autre essai, mais peut-être un peu lourd, si les cellules concernées contiennent des formules, auquel cas l'évènement change ne produira rien.

A chaque recalcul de la feuille, la macro est exécutée sur les cellules contenant des formules dont la valeur retournée est numérique :

'CODE A PLACER DANS LE MODULE DE LA FEUILLE CONCERNEE
private sub worksheet_calculate()

dim r as range
set r = columns(1).specialcells(xlcelltypeformulas, xlnumbers)
call CouleurPolice(r)

end sub

'CODE A PLACER DANS UN MODULE NORMAL
Sub CouleurPolice(Zone As Range)

Dim coul&

for each cell in Zone
    Select Case cell.value
        Case Is >= 400: coul = RGB(255,0,0)
        Case Is >= 300: coul = RGB(0,0,255)
        Case Is >= 200: coul = RGB(255,0,255)
        Case Is >= 100: coul = RGB(0,255,0)
        Case Else: coul = RGB(0, 0, 0)
    End Select
    cell.Font.Color = coul
next cell

End Sub

Cdlt,

Bonjour à tous et merci à ceux qui ont répondu, j'en ai une autre du même genre.

si des cellules de la colonne a1<100 - noir

si des cellules de la colonne a1 compris entre 100 et 200 - vert

si des cellules de la colonne a1compris entre 200 et 300 - magenta

si des cellules de la colonne a1 compris entre 300 et 400 - bleu

si des cellules de la colonne a1>400 - rouge

cela pour considérer toutes les cellules de la colonne A

en VBA

Merci à vous

remplacer :

If Not Application.Intersect(Target, Range("A1")) Is Nothing Then

par

If Target.Column = 1 Then

Bonsoir…

«les cellules concernées contiennent des formules, auquel cas l'évènement change ne produira rien.»

Chez moi il est actif avec cet autre essai (traitement par ligne et non global ) :

Private Sub Worksheet_Change(ByVal R As Range)
    If Application.Intersect(R, [A:A]) Is Nothing Or R.CountLarge > 1 Then Exit Sub
    'police automatique (noire) au départ !
    Select Case R
        Case Is < 200: R.Font.Color = vbGreen
        Case Is < 300: R.Font.Color = RGB(200, 0, 255)   'magenta
        Case Is < 400: R.Font.Color = vbBlue
        Case Else: R.Font.Color = vbRed
    End Select
End Sub

Il est vrai que l'on peut avoir des réponses différentes en fonction des comparaisons strictes (<) ou pas (<=).

Bonsoir Ordonc,

Et bien chez moi, cet essai n'est pas vraiment concluant...

Mais avec l'évènement calculate ça semble assez bien fonctionner en revanche.