Re : changer couleur listview
bonjour News,Lii,Klin
voilà un code pour la listview,vois si c'est bon dans tous les cas
Private Sub the_listview_refresh() 'to fill the data from Worksheets("dépenses")
Dim t As Byte, y As Byte, j As Byte, i As Byte
Dim c As Range, L
Dim couleur, couleur1
Dim n As Byte
'on remplit la listview
With Me.ListView05
.ListItems.Clear
For Each c In Sheets("dépenses").Range("a3:a" & Range("a65536").End(xlUp).Row)
.ListItems.Add , , c
y = .ListItems.Count
For j = 1 To 3
.ListItems(y).ListSubItems.Add , , c.Offset(0, j)
Next j
Next c
'dates sans doublons
Set mondico = CreateObject("Scripting.Dictionary")
Set rng = Sheets("dépenses").Range("b3:b" & Range("b65536").End(xlUp).Row)
For Each c In rng
If Not mondico.Exists(c.Value) Then mondico.Add c.Value, c.Value
Next c
'tableau contenant ,date,1ère ligne,nbre de lignes
ReDim L(1 To mondico.Count, 1 To 3)
For Each Item In mondico
i = i + 1: L(i, 1) = Item 'la date
Next Item
Set rng = Sheets("dépenses").Range("b1:b" & Range("b65536").End(xlUp).Row)
For i = 1 To UBound(L, 1)
Set c = rng.Find(L(i, 1), LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
If c = L(i, 1) Then
If L(i, 2) = "" Then L(i, 2) = c.Row - 2 '1ère ligne
L(i, 3) = L(i, 3) + 1 'nbre de lignes
End If
Set c = rng.FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
Next i
'couleurs listview
For Li = 1 To UBound(L, 1)
If L(Li, 3) >= 2 Then
If Li Mod 2 = 0 Then couleur = vbBlue Else couleur = vbMagenta
End If
If L(Li, 3) = 1 Then
If Li Mod 2 = 0 Then couleur = vbYellow Else couleur = vbGreen
End If
For y = L(Li, 2) To L(Li, 2) + L(Li, 3) - 1
If .ListItems(y).ListSubItems(1) > L(Li, 1) Then
.ListItems(y).ForeColor = couleur
For j = 1 To 3
.ListItems(y).ListSubItems(j).ForeColor = couleur
Next j
Else
.ListItems(y).ForeColor = couleur
For j = 1 To 3
.ListItems(y).ListSubItems(j).ForeColor = couleur
Next j
End If
Next y
Next Li
End With
End Sub
à bientôt