Discussion :

[litium]

Bonjour,

J'ai une colonne dans laquelle on peut remplir soit "standby" soit "projected" soit "finish" soit "In Progress". Je souhaiterai que la couleur de la case change en fonction du nom renseigné. Sachant que ma colonne est la "AL" et que les ligne susceptibles de changer sont de 8 à 486.

Débutant que je suis, je n'arrive pas à mes fins.

voici ma macro:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
Sub couleur1()
 
Dim I As Integer
For I = 486 To 8
Next I
 
Range("al" & I).Select
Select Case ActiveCell.Value
 
Case "Standby"
GoTo couleurStandby
 
Case "InProgress"
GoTo couleurInProgress
 
Case "Finish"
GoTo couleurFinish
 
Case "Projected"
GoTo couleur0
 
End Select
 
Exit Sub
 
couleur0:
Range("al" & I).Select
With Selection.Interior
.ColorIndex = 20
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Exit Sub
 
couleurStandby:
Range("al" & I).Select
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Exit Sub
 
couleurInProgress:
Range("al" & I).Select
'Range("al8: al486").Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Exit Sub
 
couleurFinish:
Range("al" & I).Select
With Selection.Interior
.ColorIndex = 4
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Exit Sub
End Sub

Mon second problème vient de l'exécution automatique de cette macro.

Voici la macro que j'ai mis dans ma feuille cette macro:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim I As Integer
For I = 486 To 8
Next I
If Target.Address = "$AL" & I Then
couleur1
End If
End Sub

Je galère depuis un bout de temps donc si quelqu'un sait ou je me trompe ça m'aiderait vraiment beaucoup.


Cordialement (et avec espoir)

[zandru]

Le plus simple pour appliquer une couleur à une cellule en fonction de son contenu est d'utiliser la /Mise en forme conditionnelle/ (sans passer par VBA).

[Brunodm13]

Bonsoir

Je te propose le code suivant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub Couleur()
Dim c As Range
Dim MaCouleur As Long
 
 
For Each c In Range("AL8:AL486")
Select Case c.Value
    Case "standby"
    MaCouleur = 3
    Case "projected"
    MaCouleur = 20
    Case "finish"
    MaCouleur = 4
    Case "In Progress"
    MaCouleur = 6
    Case ""
    MaCouleur = xlNone
End Select
c.Interior.ColorIndex = MaCouleur
Next c
 
End Sub

Tu peux appeler cette sub sur l'évènement Worksheet_Change de ta feuille.

Bonne soirée

Bruno

[drakkar_agfa]

Bonjour,

Tu peux aussi l'appeler à chaque fois qu'une cellule dans ton Range change.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = "AL" And Target.Row > 8 And Target.Row < 486 Then
        Call Couleur(Target)
    End If
End Sub
Sub Couleur(MaCellule As Range)
Dim MaCouleur As Long
 
Select Case MaCellule.Value
    Case "standby"
    MaCouleur = 3
    Case "projected"
    MaCouleur = 20
    Case "finish"
    MaCouleur = 4
    Case "In Progress"
    MaCouleur = 6
    Case ""
    MaCouleur = xlNone
End Select
MaCellule.Interior.ColorIndex = MaCouleur
 
End Sub

En changeant un peu la macro Couleur la couleur chagement automatiquement quand le contenu de la cellule changera.

[Gorfael]

Salut drakkar_agfa et le forum
J'utiliserais plutot ta macro comme ceci :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cel As Range
Dim Pl As Range
Set Pl = Intersect(Target, Range("AL8:AL486"))
'Pl=cellules modifiées appartenant à AL8:AL486
If Pl Is Nothing Then Exit Sub
'Si Pl est vide on sort
For Each Cel In Pl
'pour chaque cellule de Pl
    Select Case lcase(Cel)
        Case "standby"
            Cel.Interior.ColorIndex = 3
        Case "projected"
            Cel.Interior.ColorIndex = 20
        Case "finish"
            Cel.Interior.ColorIndex = 4
        Case "in progress"
            Cel.Interior.ColorIndex = 6
        Case Else
            Cel.Interior.ColorIndex = xlNone
    End Select
Next Cel
End Sub

évite un renvoi à une autre macro
Permet de traiter une copie sur multi-cellules
s'affranchit des problèmes de majuscules/minuscule (pour "In Progress" notablement)
A+