Changement de couleur progressif en VBA

lixil Messages postés 38 Statut Membre -  
lixil Messages postés 38 Statut Membre -
Bonjour tout le monde,

Je travaille sur Excel 2010 et j'aimerai faire un programme qui lorsque j'incrémente une cellule, une plage de cellule se met en couleur.
Par exemple si A1 = 1, la plage [G8 :M10] se met en couleur
si A1 = 2, La plage [G8 : M12] se met en couleur
si A1 = 3, la plage [G8 : M 14] se met en couleur etc ....
Merci
Cordialement.

A voir également:

11 réponses

g Messages postés 1285 Statut Membre 577
 
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
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
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
0
lixil Messages postés 38 Statut Membre
 
Merci bien!!!!
0
lixil Messages postés 38 Statut Membre
 
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?
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
à installer dans le module feuille concerné

faire un copier de la macro

clic droit sur l'onglet de la feuille(en bas de l'"cran)
visualiser le coder

coller
0

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question
lixil Messages postés 38 Statut Membre
 
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
0
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 282
 
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.
0
lixil Messages postés 38 Statut Membre
 
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!
0
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 282
 
Re,

on s'est croisé, jete un oeil au-dessus.
eric

edit: finalement oublie ma proposition.
Quand je vois ton code qui n'a rien à voir avec ce que tu demandais : les plages n'augmentent pas régulièrement, les couleurs changent... Bref, même pas la peine d'essayer.
eric
0
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
Je reprends les patins d'Eeric(bonsoir)
ton code n'a rien à voir avec ce que tu demandais
Encore du temps perdu bénévolement
Lixil noté sur carnet noir: ne plus répondre
0
lixil Messages postés 38 Statut Membre
 
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
0
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 282
 
Ce que je t'ai proposé fait exactement ça :
Par exemple si A1 = 1, la plage [G8 :M10] se met en couleur
si A1 = 2, La plage [G8 : M12] se met en couleur
si A1 = 3, la plage [G8 : M 14] se met en couleur etc

etc compris

Au lieu d'incrémenter les cellules à mettre en couleur il faut décrémenter.

Donc ce n'est pas ce que tu as demandé...
donne la règle exacte

eric
0
lixil Messages postés 38 Statut Membre
 
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 ....
0
eriiic Messages postés 25847 Date d'inscription   Statut Contributeur Dernière intervention   7 282
 
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
0
lixil Messages postés 38 Statut Membre
 
Merci beaucoup Eric ça marche du tonnerre!!!
0