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 |
Partager