J’utilise cet utilitaire pour alterner la couleur de fond des lignes sur changement de valeur dans une colonne de référence.

Dans l’exemple présenté, la colonne de référence est la colonne Projet. Les lignes 4 et 5, 11, 12 et 13, 16, 17 et 18 contiennent respectivement les projets 2, 9 et 14.

Pièce jointe 167629


La macro AlternerlesCouleurs permet de changer les couleurs sur changement de projet.

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 AlternerLesCouleurs(ByVal FeuilleCouleurs As Worksheet, ByVal LigneTitre As Long, ByVal ColonneReference As Long)
 
Dim DerniereColonne As Long
Dim DerniereLigne As Long
Dim CtrI As Long
 
Dim ValeurEncours As Variant
Dim Couleur1(2) As Variant
Dim Couleur2(2) As Variant
Dim CouleurEnCours(2) As Variant
 
    Couleur1(0) = 255
    Couleur1(1) = 255
    Couleur1(2) = 255
 
    Couleur2(0) = 228
    Couleur2(1) = 223
    Couleur2(2) = 236
 
    With FeuilleCouleurs
 
            DerniereLigne = .Cells(.Rows.Count, ColonneReference).End(xlUp).Row
            DerniereColonne = .Cells(LigneTitre, .Columns.Count).End(xlToLeft).Column
 
            CouleurEnCours(0) = Couleur1(0)
            CouleurEnCours(1) = Couleur1(1)
            CouleurEnCours(2) = Couleur1(2)
 
            ValeurEncours = .Cells(LigneTitre + 1, ColonneReference)
 
            With Range(.Cells(LigneTitre + 1, 1), .Cells(DerniereLigne, DerniereColonne)).Interior
                    .Pattern = xlNone
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
            End With
 
            For CtrI = LigneTitre + 1 To DerniereLigne
 
                       If Cells(CtrI, ColonneReference) = ValeurEncours Then
                            Range(.Cells(CtrI, 1), .Cells(CtrI, DerniereColonne)).Interior.Color = RGB(CouleurEnCours(0), CouleurEnCours(1), CouleurEnCours(2))
                       Else
                          If CouleurEnCours(0) = Couleur1(0) Then
                                CouleurEnCours(0) = Couleur2(0)
                                CouleurEnCours(1) = Couleur2(1)
                                CouleurEnCours(2) = Couleur2(2)
                          Else
                                CouleurEnCours(0) = Couleur1(0)
                                CouleurEnCours(1) = Couleur1(1)
                                CouleurEnCours(2) = Couleur1(2)
                          End If
 
                          Range(.Cells(CtrI, 1), .Cells(CtrI, DerniereColonne)).Interior.Color = RGB(CouleurEnCours(0), CouleurEnCours(1), CouleurEnCours(2))
                          ValeurEncours = .Cells(CtrI, ColonneReference)
 
                       End If
 
            Next CtrI
 
    End With
 
End Sub

Pour cela, il suffit de définir : l'onglet, la ligne de titre et la colonne de référence.


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
Sub TestAlternerLesCouleurs()
 
Dim LigneDeTitre As Long
Dim ColReference As Long
 
  LigneDeTitre = 2
  ColReference = 1
  AlternerLesCouleurs Sheets("Situation 2014-12-31"), LigneDeTitre, ColReference
 
End Sub