Sub RemplirGrille()
On Error Resume Next
Dim f As Worksheet
Dim Lr As Long
Dim Ligne As Integer
Dim c As Variant
Dim LstItem As MSComctlLib.ListItem
Dim LstVSitem As MSComctlLib.ListSubItem
Dim Col As Byte
Dim VCol
Set f = ThisWorkbook.Sheets("Factures")
With lstFactures
.ListItems.Clear
With .ColumnHeaders
.Clear
.Add , , "En-tête 1", 0, 0
.Add , , "En-tête 2", 65, 1
.Add , , "En-tête 3", 18, 2
.Add , , "En-tête 4", 65, 1
.Add , , "En-tête 5", 140, 0
.Add , , "En-tête 6", 60, 1
.Add , , "En-tête 7", 55, 1
.Add , , "En-tête 8", 65, 1
.Add , , "En-tête 9", 55, 1
.Add , , "En-tête 10", 55, 1
.Add , , "En-tête 11", 55, 1
.Add , , "En-tête 12", 55, 1
.Add , , "En-tête 13", 55, 1
.Add , , "En-tête 14", 75, 1
.Add , , "En-tête 15", 55, 1
.Add , , "En-tête 16", 55, 1
.Add , , "En-tête 17", 55, 1
.Add , , "En-tête 18", 55, 1
.Add , , "En-tête 19", 55, 1
.Add , , "En-tête 20", 55, 1
.Add , , "En-tête 21", 55, 1
.Add , , "En-tête 22", 150, 0
.Add , , "En-tête 23", 0, 1
.Add , , "En-tête 24", 0, 1
.Add , , "En-tête 25", 0, 1
.Add , , "En-tête 26", 0, 1
.Add , , "En-tête 27", 0, 1
.Add , , "En-tête 28", 0, 1
.Add , , "En-tête 29", 0
End With
.View = lvwReport
.Gridlines = True
.FullRowSelect = True
Lr = Range("A" & Rows.Count).End(xlUp).Row
For Each c In f.Range("A2:A" & Lr)
If Lr = 1 Then Exit Sub
If Month(CDate(f.Cells(Ligne + 1, 2))) = 4 And Year(CDate(f.Cells(Ligne + 1, 2))) = 2019 Then
Set LstItem = .ListItems.Add(, , c)
With LstItem
For Col = 1 To 28
VCol = IIf(Col > 4 And Col < 21, Format(c.Offset(, Col), "### ##0.00") & " $", c.Offset(, Col))
Set LstVSitem = .ListSubItems.Add(, , VCol)
Next Col
End With
End If
Ligne = Ligne + 1
Next c
.View = lvwReport
.Gridlines = True
.FullRowSelect = True
End With
Call Classer
On Error Goto 0
End Sub