Changement de couleur progressif en VBA

Bonjour,

Tu peux utiliser le code suivant en le complétant jusqu'où tu le souhaites:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A1") = 1 Then
Range("G8:M10").Interior.ColorIndex = 4
ElseIf Range("A1") = 2 Then
Range("G8:M12").Interior.ColorIndex = 4
ElseIf Range("A1") = 3 Then
Range("G8:M14").Interior.ColorIndex = 4
'etc.....
ElseIf Range("A1") = "" Then
Range("G8:M100").Interior.ColorIndex = xlNone
End If
End Sub

Cordialement

bonjour,

Private Sub Worksheet_Change(ByVal Target As Range) 
If Target.Address = "$A$1" And Target.Count = 1 Then 
     Select Case .Target 
          Case Is < 1, Is > 3 
               Range("G8:M14").Interior.ColorIndex = xlNone 
          Case Is = 1 
               Range("G8:M10").Interior.ColorIndex = 20 'bleu ciel 
          Case Is = 2 
               Range("G8:M12").Interior.ColorIndex = 17 'violet 
          Case Is = 3 
               Range("G8:M14").Interior.ColorIndex = 35 'vert pale 
     End Select 
End If 
End Sub 

à installer dans le module feuille concerné

Michel

Merci bien!!!!

Bon après avoir essayer les solutions il n'y en a aucune qui marche ...

Quand je finis de taper mon programme j'enregistre je compile et j'exécute.
Lorsque j'exécute il me demande quel macro je veux exécuter et il n'y a pas celle que je veux.

une solution à ce problème?

Voila le premier:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("B17") = 2 Then
Range("DR246:DW245").Interior.ColorIndex = 6

ElseIf Range("B17") = 3 Then
Range("DR246:DW242").Interior.ColorIndex = 6

ElseIf Range("B17") = 4 Then
Range("DR246:DW239").Interior.ColorIndex = 6

...........
...........

ElseIf Range("B17") = 28 Then
Range("DR246:DW167").Interior.ColorIndex = 6

ElseIf Range("B17") = 29 Then
Range("DR246:DW164").Interior.ColorIndex = 6

ElseIf Range("B17") = 1 Then
Range("dr246:DW161").Interior.ColorIndex = xlNone
End If
End Sub

et voila pour le deuxieme:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$B$17" And Target.Count = 1 Then
Select Case Target.Address
Case Is < 2, Is > 4
Range("DR246:DW239").Interior.ColorIndex = xlNone
Case Is = 2
Range("DR246:DW245").Interior.ColorIndex = 6 'bleu ciel
Case Is = 3
Range("DR246:DW242").Interior.ColorIndex = 6 'violet
Case Is = 4
Range("DR246:DW239").Interior.ColorIndex = 6 'vert pale
End Select
End If
End Sub

Bonsoir,

je n'ai pas eu tout à fait la même lecture que mes camarades :

Private Sub Worksheet_Change(ByVal Target As Range)  
    If Target <> [A1] Or Target.Cells.Count > 1 Then Exit Sub  
    [G:M].Interior.ColorIndex = xlNone  
    If [A1] > 0 Then [G8].Resize([A1] * 2 + 1, 7).Interior.ColorIndex = 22  
End Sub

https://www.cjoint.com/?BKfxkL9ACVn

eric
Jamais tu ne répondras à un mp non sollicité...
Bon, ça c'est fait.

Pour la deuxieme solution je n'ai pas essayer toutes les possibilités... J'ai voulu voir si sa marchait avec 3 therme avant de me lancer pour tous!

SI SI vous avez bien compris
c'est juste que je me suis mal démerdé dans la programmation et du coup sa n'a plus rien avoir avec ce que je voulais apparemment!!

Ton programme correspond Eric mais je ne le comprend pas et donc je n'arrive pas à le modifier a souhait.

Au lieu d'incrémenter les cellules à mettre en couleur il faut décrémenter. j'ai essayer de le faire sur le fichier que tu as envoyé mais j'ai pas réussi
Mais sinon c'est exactement sa que je veux!!

Excuser si j'me suis mal exprimé dans la programmation

c'est vrai !
Par exemple si A1 = 1, la plage [G15 :M14] se met en couleur
si A1 = 2, La plage [G15 : M12] se met en couleur
si A1 = 3, la plage [G15 : M10] se met en couleur etc ....

Bonjour,

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Target <> [A1] Then Exit Sub
    [G:M].Interior.ColorIndex = xlNone
    If [A1] > 0 And [A1] < 8 Then Range("G" & (8 - [A1]) * 2 & ":M15").Interior.ColorIndex = 22
End Sub 

eric

Merci beaucoup Eric ça marche du tonnerre!!!