Coloration ligne en fonction de ce qu'il y a dans une cellule

**Walt51** · 07/02/2017, 14h11

Bonjour,

J'ai un tableau Excel avec des colonne de A à O.
J'ai un code qui permet de compléter ce tableau de façon automatique, mais pour des raisons de lisibilité je souhaite que les lignes soient coloriées.
Chacune des lignes correspond à un commande. Dans la colonne O on a l'état. En fonction de l'état de la commande je souhait attribuer une couleur différente

Voici mon code

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
Private Sub Worksheet_Activate()
 
Call ChargerVisuHistoriqueCommandes
 
 
 
'Pour chaque lignes (de A à O) de la ligne 2 jusqu'à la dernière,
 
'si ce qui est dans la cellule "O" = "Commande envoyée par e-mail"
'alors on colori la ligne en bleu
 
'si ce qui est dans la cellule "O" = "Matériel reçu"
'alors on colori la ligne en vert
 
'si ce qui est dans la cellule "O" = "Commande annulée"
'alors on colori la ligne en rouge
 
End Sub

Quelqu'un a t'il une idée?
Merci

**joe.levrai** · 07/02/2017, 14h16

Bonjour,

une mise en forme conditionnelle ne ferait pas l'affaire ? Ca permet en plus de faire varier dynamiquement les couleurs si un statut est amené à changer

sinon, côté VBA, il faut faire un test sur la valeur (.Value) de la cellule, et en fonction de cette valeur (utilisation d'un Select Case) colorier le fond de la cellule (Range("A1").Interior.Color = xxxx)

Bon courage

**Walt51** · 08/02/2017, 11h30

Bonjour,

Voilà j'ai écrit mon code (je progresse lol) par contre j'ai un plantage "dépassement de capacité" quand je lui demande de modifier jusqu’à la dernière ligne.
J'ai essayé, si j'indique 2000 ça marche.
Pourtant il me faut impérativement aller jusqu'a la dernière ligne.

Quelqu'un a-t-il une idée?

Merci

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim i As Integer
 
Dim DerLig As Long
    With Worksheets("Visu historique des commandes")
        DerLig = .Range("A1").End(xlDown).Row
'        MsgBox "Numéro de la dernière ligne : " & DerLig
    End With
 
If Not Application.Intersect(Target, Range("B2:O65000")) Is Nothing Then 'si pas de changement de valeur dans les cellules B20 à I141 => rien , sinon
 
 
Application.EnableEvents = False 'désactiver les évènements pendant la macro 
 
'For i = 0 To DerLig 'compteur de 0 à la dernière ligne => plantage "dépassement de capacité"
 
For i = 0 To 2000 ' pas de soucis
 
If Range("O2").Offset(i).Value = "ARC reçu" Then
    Range("A2:O2").Offset(i).Interior.Color = RGB(255, 255, 204)
    End If
 
If Range("O2").Offset(i).Value = "Commande annulée" Then
    Range("A2:O2").Offset(i).Interior.Color = RGB(255, 0, 0)
    End If
 
If Range("O2").Offset(i).Value = "Commande envoyée par e-mail" Then
    Range("A2:O2").Offset(i).Interior.Color = RGB(0, 255, 255)
    End If
 
If Range("O2").Offset(i).Value = "Commande envoyée par fax" Then
    Range("A2:O2").Offset(i).Interior.Color = RGB(0, 255, 255)
    End If
 
If Range("O2").Offset(i).Value = "Commande passée sur le site" Then
    Range("A2:O2").Offset(i).Interior.Color = RGB(178, 102, 255)
    End If
 
If Range("O2").Offset(i).Value = "Commande passée sur le site" Then
    Range("A2:O2").Offset(i).Interior.Color = RGB(178, 102, 255)
    End If
 
If Range("O2").Offset(i).Value = "Matériel reçu chez SEDAM" Then
    Range("A2:O2").Offset(i).Interior.Color = RGB(153, 255, 153)
    End If
 
If Range("O2").Offset(i).Value = "Réception partielle" Then
    Range("A2:O2").Offset(i).Interior.Color = RGB(255, 153, 21)
    End If
 
Application.EnableEvents = True 'Résactiver les évènements pendant la macro
 
Next
 
End If
 
 
End Sub

**Marc-L** · 08/02/2017, 11h33

Bonjour,

comme d'hab' corriger la ligne n°3 !

Rien qu'en lisant l'aide de l'erreur sans oublier la ligne n°5 et l'aide VBA d'Integer et de Long …

_________________________________________________________________________________________________________

Je suis Paris, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

**pijaku** · 08/02/2017, 11h58

Bonjour,

Un Select Case serait peut-être plus judicieux que cette succession de tests.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Dim Couleur
Select Case Range("O2").Offset(i).Value 
    Case "ARC reçu" 
        Couleur = RGB(255, 255, 204)
    Case "Commande annulée" 
        Couleur = RGB(255, 0, 0)
 'Etc....
    Case "Réception partielle"
        Couleur = RGB(255, 153, 21)
End Select
Range("A2:O2").Offset(i).Interior.Color = Couleur

De plus mets ta ligne 52 (Application.EnableEvents = True 'Résactiver les évènements pendant la macro) en 55 (après le Next).

**Walt51** · 08/02/2017, 14h00

Envoyé par pijaku

Bonjour,

Un Select Case serait peut-être plus judicieux que cette succession de tests.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Dim Couleur
Select Case Range("O2").Offset(i).Value 
    Case "ARC reçu" 
        Couleur = RGB(255, 255, 204)
    Case "Commande annulée" 
        Couleur = RGB(255, 0, 0)
 'Etc....
    Case "Réception partielle"
        Couleur = RGB(255, 153, 21)
End Select
Range("A2:O2").Offset(i).Interior.Color = Couleur

De plus mets ta ligne 52 (Application.EnableEvents = True 'Résactiver les évènements pendant la macro) en 55 (après le Next).

Merci c'est vrai que c'est plus simple et aussi efficace. Par contre je n'arrive pas à me débarrasser du message d'erreur.
J'ai remplacé en ligne 3 "Integer" par "Long" mais du coup plantage à la ligne 25.

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
Private Sub Worksheet_Change(ByVal Target As Range)
 
Dim i As Long
 
Dim DerLig As Long
    With Worksheets("Visu historique des commandes")
        DerLig = .Range("A1").End(xlDown).Row
'        MsgBox "Numéro de la dernière ligne : " & DerLig
    End With
 
If Not Application.Intersect(Target, Range("B2:O65000")) Is Nothing Then 'si pas de changement de valeur dans les cellules B20 à I141 => rien , sinon
 
 
Application.EnableEvents = False 'désactiver les évènements pendant la macro (sinon la macro ne peut pas supprimer les cellules
 
For i = 0 To DerLig 'compteur de 0 à la dernière ligne => plantage "dépassement de capacité"
 
'For i = 0 To 2000 ' pas de soucis
 
 
 
 
 
Dim Couleur
Select Case Range("O2").Offset(i).Value
    Case "ARC reçu"
        Couleur = RGB(255, 255, 204)
    Case "Commande annulée"
        Couleur = RGB(255, 0, 0)
    Case "Commande annulée"
        Couleur = RGB(255, 0, 0)
    Case "Commande envoyée par e-mail"
        Couleur = RGB(0, 255, 255)
    Case "Commande envoyée par fax"
        Couleur = RGB(0, 255, 255)
    Case "Commande passée sur le site"
        Couleur = RGB(178, 102, 255)
    Case "Matériel reçu chez SEDAM"
        Couleur = RGB(153, 255, 153)
    Case "Réception partielle"
        Couleur = RGB(255, 153, 21)
End Select
Range("A2:O2").Offset(i).Interior.Color = Couleur
 
 
 
 
Next
 
Application.EnableEvents = True 'Résactiver les évènements pendant la macro
 
End If
 
 
End Sub

**Walt51** · 08/02/2017, 13h52

Envoyé par Marc-L

Bonjour,

comme d'hab' corriger la ligne n°3 !

Rien qu'en lisant l'aide de l'erreur sans oublier la ligne n°5 et l'aide VBA d'Integer et de Long …

_________________________________________________________________________________________________________

Je suis Paris, Istanbul, Berlin, Nice, Bruxelles, Charlie, …

Désolé mais j'ai pas le niveau (pour le moment) je suis un pauvre dessinateur industriel qui fait du mieux qu'il peut pour faciliter son travail.
Merci quand même

Coloration ligne en fonction de ce qu'il y a dans une cellule [XL-2013]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager