Filtre ListView avec deux combobox

**jopont** · 10/03/2017, 17h00

Bonjour,

Avec la macro ci-dessous, j'alimente à l'initialisation ma listview et je rempli les deux combobox :
Ces deux macro fonctionnent. Seulement la troisième macro, celle du filtre ne fonctionne pas(Sub RemplissageListView()).
Je ne comprends ou ça dysfonctionne dans Sub RemplissageListView()
Merci pour votre aide

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Private Sub UserForm_Initialize()
   Dim MondicoStat As Object, MondicoMand As Object, MondicoResp As Object
Dim J As Long, T2
 
 Set Ws = Sheets("consignes")
 
  Set MondicoStat = CreateObject("Scripting.dictionary")
  Set MondicoMand = CreateObject("Scripting.dictionary")
  'Set MondicoResp = CreateObject("Scripting.dictionary")
 
  With Ws
    For J = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      If .Range("H" & J) <> "" Then MondicoStat(.Range("H" & J).Value) = ""
      If .Range("G" & J) <> "" Then MondicoMand(.Range("G" & J).Value) = ""
      'If .Range("C" & J) <> "" Then MondicoResp(.Range("C" & J).Value) = ""
    Next J
  End With
  If MondicoStat.Count > 0 Then T2 = MondicoStat.keys: Tri T2, LBound(T2), UBound(T2): Me.mois.List = T2
  If MondicoMand.Count > 0 Then T2 = MondicoMand.keys: Tri T2, LBound(T2), UBound(T2): Me.annee.List = T2
  'If MondicoResp.Count > 0 Then T2 = MondicoResp.keys: Tri T2, LBound(T2), UBound(T2): Me.CbbResponsable.List = T2
 
End Sub
Private Sub LVW_Fill(ByVal sFilter As String, ByVal iCol As Integer)
'Variables locales
    Dim iCnt As Integer
    Dim iRnd As Integer
    Dim oRng As Excel.Range
    Dim oItem As ListItem
 
    ListView1.ColumnHeaders.Clear
    ListView1.ListItems.Clear
    'Remplissage de la ListView
    Set oRng = Base.Cells(1, 1)
    Do Until oRng.Offset(0, 0).Value = ""
        '-- En-têtes
        If oRng.Row = 1 Then
            For iCnt = 0 To 7
                If iCnt = 0 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 60
                ElseIf iCnt = 1 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 60
                ElseIf iCnt = 2 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 70
                 ElseIf iCnt = 3 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 70
                    ElseIf iCnt = 4 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 300
                    ElseIf iCnt = 5 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 70
                    ElseIf iCnt = 6 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 30
                    ElseIf iCnt = 7 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 30
              Else
                  ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 150
 
                End If
            Next iCnt
            '-- Données
        Else
            ' iRnd = Int((4 * Rnd) + 1)
            If LCase$(Left$(oRng.Offset(0, iCol), Len(sFilter))) = LCase$(sFilter) Then
                Set oItem = ListView1.ListItems.Add(, , DateSerial(Left(oRng.Offset(0, 0), 4), Mid(oRng.Offset(0, 0), 5, 2), Right(oRng.Offset(0, 0), 2)))    ', "Key" & iRnd, "Key" & iRnd)
                For iCnt = 1 To 1  '-- 5 colonnes
                    oItem.ListSubItems.Add , , DateSerial(Left(oRng.Offset(0, iCnt), 4), Mid(oRng.Offset(0, iCnt), 5, 2), Right(oRng.Offset(0, iCnt), 2))
                Next iCnt
                For iCnt = 2 To 7
                    oItem.ListSubItems.Add , , oRng.Offset(0, iCnt)
                Next iCnt
            End If
        End If
        Call Filtre
        With ListView1
 
       If ListView1.Sorted = False Then
        ListView1.SortKey = 7
        ListView1.SortOrder = lvwAscending
        ListView1.Sorted = True
 
        End If
        End With
        Set oRng = oRng.Offset(1, 0)
    Loop
 
End Sub

macro du filtre sur le mois et l'année :

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
Sub RemplissageListView()
Dim J As Long, I As Integer, Nb As Integer
 
  With Me.ListView1
    .ListItems.Clear
    For J = 2 To Range("H" & Rows.Count).End(xlUp).Row
      If Ws.Range("H" & J) Like Me.mois & "*" And Ws.Range("G" & J) Like Me.annee & "*" Then
         'And ws.Range("H" & J) Like Me.CbbMandant & "*" And _ ws.Range("I" & J) Like Me.CbbResponsable & "*" Then
        .ListItems.Add , Ws.Cells(J, "A").Address, Ws.Cells(J, "A")
        Nb = Nb + 1
        For I = 0 To .ColumnHeaders.Count
          .ListItems(Nb).ListSubItems.Add , , Ws.Cells(J, 1 + I)
        Next I
      End If
    Next J
  End With
End Sub

**unparia** · 10/03/2017, 23h31

Bonjour
Où es-tu allé chercher tes subitems et une méthode Add les concernant ?
Moi, je m'en tiens à la seule lecture de l'aide VBA et arrive à ceci, par exemple, pour une listbox à deux colonnes :
C'est un EXEMPLE :

Code :

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

1
2
3
4
For i = 1 To 10
  ListBox1.AddItem "a " & i
  ListBox1.List(ListBox1.ListCount - 1, 1) = "coucou " & i
Next

**jopont** · 11/03/2017, 07h54

Bonjour,
mais il ne s'agit pas de listbox mais de listview.

je ne trouve pas la solution.

Merci

**unparia** · 11/03/2017, 14h21

Ah ! Une listview ...
exemple avec ce composant, alors :
Cet exemple montre comment alimenter les subitems (on s'y réfère par leur index et non par une "méthode Add)).

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
Randomize
    ListView1.ColumnHeaders.Add , , "Nom", ListView1.Width / 3
    ListView1.ColumnHeaders.Add , , "prénom ID", ListView1.Width / 3, lvwColumnCenter
    ListView1.ColumnHeaders.Add , , "date de naissance", ListView1.Width / 3
    ListView1.ColumnHeaders.Add , , "", 0
    Dim itmX As ListItem
    For i = 1 To 10
       Set itmX = ListView1.ListItems.Add(, , Int((9 * Rnd) + 1))
       itmX.SubItems(1) = "a" & Int((9 * Rnd) + 1)
       If i Mod 2 = 0 Then
          itmX.SubItems(2) = "17/02/2000"
           itmX.SubItems(3) = "20000117"
       Else
          itmX.SubItems(2) = "20/03/2002"
          itmX.SubItems(3) = "20020320"
       End If
    Next

Ceci dit : je ne saurais trop te conseiller d'utiliser une listbox (composant natif de VBA) plutôt qu'une Listview (non native et donc sujette à beaucoup de "choses" en fonction de la version Office et celle de l'OS)

**jopont** · 12/03/2017, 09h57

Bonjour,

A priori une listbox n'est pas cliquable donc non modifiable, c'est pour cela que j'ai pris une listView.

avec la listView, je ne comprends pas pourquoi la macro de remplissage ne fonctionne pas.

Merci

**jopont** · 13/03/2017, 11h55

Bonjour,
Je n'arrive pas à trouver la solution alors que cette macro fonctionne dans un autre classeur.
Le début des ligne de la feuille commencent à cellule A2.
Le mois est sur la colonne H et l'année en G

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
Sub RemplissageListView()
Dim J As Long, I As Integer, Nb As Integer
 
  With Me.ListView1
    .ListItems.Clear
    For J = 2 To Range("A" & Rows.Count).End(xlUp).Row
      If Ws.Range("H" & J) Like Me.mois & "*" And Ws.Range("G" & J) Like Me.annee & "*" Then
         'And ws.Range("H" & J) Like Me.CbbMandant & "*" And _ ws.Range("I" & J) Like Me.CbbResponsable & "*" Then
        .ListItems.Add , Ws.Cells(J, "A").Address, Ws.Cells(J, "A")
        Nb = Nb + 1
        For I = 0 To .ColumnHeaders.Count
          .ListItems(Nb).ListSubItems.Add , , Ws.Cells(J, 1 + I)
        Next I
      End If
    Next J
  End With
End Sub

Merci

**jopont** · 13/03/2017, 18h26

J'ai réussi avec ce code, mais par contre je n'arrive pas à trier l'affichage en fonction de la première colonne de la ListView1

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
Sub AlimenteListview()
Dim i As Integer, j, X, Y, k
Dim MonTab As Variant
 
MonTab = Sheets("consignes").Range("A2:H" & Sheets("consignes").Range("A" & Rows.Count).End(xlUp).Row)
 
'Remplissage de la listview
  With frmFiltre
  'MsgBox UBound(MonTab, 1)
    .ListView1.ListItems.Clear
 
 
 
    For i = 1 To UBound(MonTab, 1)
        If MonTab(i, 1) <> "" _
        And MonTab(i, 3) Like "*" & .nom & "*" _
        And MonTab(i, 8) Like "*" & .mois & "*" _
           And MonTab(i, 7) Like "*" & .annee & "*" Then
 
 
 
             .ListView1.ListItems.Add , , DateSerial(Left(MonTab(i, 1), 4), Mid(MonTab(i, 1), 5, 2), Right(MonTab(i, 1), 2))
             For j = 2 To 2
            .ListView1.ListItems(.ListView1.ListItems.Count).ListSubItems.Add , , DateSerial(Left(MonTab(i, 2), 4), Mid(MonTab(i, 2), 5, 2), Right(MonTab(i, 2), 2))
            Next j
            For j = 3 To 7
 
            .ListView1.ListItems(.ListView1.ListItems.Count).ListSubItems.Add , , MonTab(i, j)
 
            Next j
 
        End If
    Next i
           If .ListView1.Sorted = False Then
        .ListView1.SortKey = 1
        .ListView1.SortOrder = lvwAscending
        .ListView1.Sorted = True
 
        End If
 
  End With
End Sub

**unparia** · 14/03/2017, 08h33

Le code par lequel tu tries ne contenant aucune erreur, je ne comprends pas ce que tu lui reproches.
Je te fais donc simplement observer (sait-on jamais) que ces instructions seront ignorées (et pour cause) si la propriété sorted de ta listview est déjà à True
Je te rappelle par ailleurs (sait-on jamais également) que les éléments d'une listview sont de type string et que si tu tries sur des "nombres" ou des "dates", tu pourras avoir des surprises ("10" est plus petit que "2", par exemple, alors que 10 est plus grand que 2).
Expose s'il te plait plus complètement la difficulté que tu rencontres.

**jopont** · 14/03/2017, 10h09

Bonjour,

La macro AlimenteListView se déclenche sur l'événement change d'une des trois combobox ( nom, mois, année).
Je souhaiterais trier par ordre croissant des dates (première colonne du ListView).

J'ai pensez donc à deux solutions : soit trier à l'aide de la propriété sorted des listview, ou alors trier ma variable tableau (Montab).

Merci pour vos réponses

**unparia** · 14/03/2017, 11h50

S tu veux trier ta listview par dates et garder ces dates en format "confortable", utilise ce petit truc :
- une colonne additionnelle (rendue "invisible" en lui attribuant une largeur 0)
- y mettre les dates de ta colonne 1 en format "yyyymmdd" (en même temps que tu ajoutes tes dates en colonne 1 sous le format "confortable")
- procéder à ton tri sur la base de cette colonne additionnelle.
Voilà tout.

**jopont** · 14/03/2017, 17h06

Merci pour cette réponse, mais je met quel type de code pour faire tout ça.
Merci

**unparia** · 14/03/2017, 20h49

mais je met quel type de code pour faire tout ça.

Celui qui correspond à ... ce que je t'ai suggéré.
Qu'en fais-tu ? Qu'as-tu tenté d'en faire ? --->> je veux le voir, cet effort ... (telle est ma "religion").

**jopont** · 15/03/2017, 12h38

Merci à toi pour la solution envisagée.
J'ai procédé comme ci-dessous :

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
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Private Sub UserForm_Initialize()
   Dim MondicoStat As Object, MondicoMand As Object, MondicoResp As Object
Dim j As Long, T2
Sheets("consignes").Range("A2:H" & Sheets("consignes").Range("A" & Rows.Count).End(xlUp).Row).Sort key1:=Sheets("consignes").Range("A2:A" & Sheets("consignes").Range("A" & Rows.Count).End(xlUp).Row), _
    order1:=xlAscending, Header:=xlNo
 Set Ws = Sheets("consignes")
 
  Set MondicoStat = CreateObject("Scripting.dictionary")
  Set MondicoMand = CreateObject("Scripting.dictionary")
  Set MondicoResp = CreateObject("Scripting.dictionary")
 
  With Ws
    For j = 2 To .Range("A" & Rows.Count).End(xlUp).Row
      If .Range("H" & j) <> "" Then MondicoStat(.Range("H" & j).Value) = ""
      If .Range("G" & j) <> "" Then MondicoMand(.Range("G" & j).Value) = ""
      If .Range("C" & j) <> "" Then MondicoResp(.Range("C" & j).Value) = ""
    Next j
  End With
  If MondicoStat.Count > 0 Then T2 = MondicoStat.keys: Tri T2, LBound(T2), UBound(T2): Me.mois.List = T2
  If MondicoMand.Count > 0 Then T2 = MondicoMand.keys: Tri T2, LBound(T2), UBound(T2): Me.annee.List = T2
  If MondicoResp.Count > 0 Then T2 = MondicoResp.keys: Tri T2, LBound(T2), UBound(T2): Me.nom.List = T2
 
End Sub
Private Sub LVW_Fill(ByVal sFilter As String, ByVal iCol As Integer)
'Variables locales
    Dim iCnt As Integer
    Dim iRnd As Integer
    Dim oRng As Excel.Range
    Dim oItem As ListItem
 
    ListView1.ColumnHeaders.Clear
    ListView1.ListItems.Clear
    'Remplissage de la ListView
    Set oRng = Base.Cells(1, 1)
    Do Until oRng.Offset(0, 0).Value = ""
        '-- En-têtes
        If oRng.Row = 1 Then
            For iCnt = 0 To 8
                If iCnt = 0 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 0
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 60
                ElseIf iCnt = 1 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 60
                ElseIf iCnt = 2 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 70
                 ElseIf iCnt = 3 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 70
                    ElseIf iCnt = 4 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 300
                    ElseIf iCnt = 5 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 70
                    ElseIf iCnt = 6 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 30
                    ElseIf iCnt = 7 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 30
                    ElseIf iCnt = 8 Then
                    ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 30
              Else
                  ListView1.ColumnHeaders.Add , , oRng.Offset(0, iCnt), 150
 
                End If
            Next iCnt
            '-- Données
        Else
            ' iRnd = Int((4 * Rnd) + 1)
            If LCase$(Left$(oRng.Offset(0, iCol), Len(sFilter))) = LCase$(sFilter) Then
                'Set oItem = ListView1.ListItems.Add(, , DateSerial(Left(oRng.Offset(0, 0), 4), Mid(oRng.Offset(0, 0), 5, 2), Right(oRng.Offset(0, 0), 2)))    ', "Key" & iRnd, "Key" & iRnd)
                Set oItem = ListView1.ListItems.Add(, , oRng.Offset(0, 0))
                For iCnt = 1 To 1
                    oItem.ListSubItems.Add , , DateSerial(Left(oRng.Offset(0, 0), 4), Mid(oRng.Offset(0, 0), 5, 2), Right(oRng.Offset(0, 0), 2))
                    oItem.ListSubItems.Add , , DateSerial(Left(oRng.Offset(0, iCnt), 4), Mid(oRng.Offset(0, iCnt), 5, 2), Right(oRng.Offset(0, iCnt), 2))
                Next iCnt
                For iCnt = 2 To 8
                    oItem.ListSubItems.Add , , oRng.Offset(0, iCnt)
                Next iCnt
            End If
        End If
        Call Filtre
        With ListView1
 
 
 
 
        End With
        Set oRng = oRng.Offset(1, 0)
    Loop
 
 
End Sub

Et lors du choix dans l'une des trois combos :

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
Sub AlimenteListview()
Dim i As Integer, j, X, Y, k
Dim MonTab As Variant
 
MonTab = Sheets("consignes").Range("A2:H" & Sheets("consignes").Range("A" & Rows.Count).End(xlUp).Row)
 
'Remplissage de la listview
  With frmFiltre
  'MsgBox UBound(MonTab, 1)
    .ListView1.ListItems.Clear
 
 
 
    For i = 1 To UBound(MonTab, 1)
        If MonTab(i, 1) <> "" _
        And MonTab(i, 3) Like "*" & .nom & "*" _
        And MonTab(i, 8) Like "*" & .mois & "*" _
           And MonTab(i, 7) Like "*" & .annee & "*" Then
 
 
            .ListView1.ListItems.Add , , MonTab(i, 1)
 
             For j = 2 To 2
             .ListView1.ListItems(.ListView1.ListItems.Count).ListSubItems.Add , , DateSerial(Left(MonTab(i, 1), 4), Mid(MonTab(i, 1), 5, 2), Right(MonTab(i, 1), 2))
            .ListView1.ListItems(.ListView1.ListItems.Count).ListSubItems.Add , , DateSerial(Left(MonTab(i, 2), 4), Mid(MonTab(i, 2), 5, 2), Right(MonTab(i, 2), 2))
            Next j
            For j = 3 To 8
 
            .ListView1.ListItems(.ListView1.ListItems.Count).ListSubItems.Add , , MonTab(i, j)
 
            Next j
 
        End If
    Next i
 
    If ListView1.Sorted = False Then
        ListView1.SortKey = 0
        ListView1.SortOrder = lvwAscending
 
        ListView1.Sorted = True
 
        End If
  End With
End Sub

**jopont** · 15/03/2017, 15h29

J'ai réussi à supprimer des lignes depuis la Listview, seulement quand je filtre avec les combobox ça supprime les mauvaises lignes sur la feuille excel

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
Private Sub CommandButton1_Click()
 Dim VarReponse As String, L As Long, Li As Long
 
Dim SuppLigne As Long
    VarReponse = MsgBox("Effacer les données?", vbYesNo, "Alerte")
    If VarReponse = vbNo Then Exit Sub
 
SuppLigne = Me.ListView1.SelectedItem.Index + 1
MsgBox SuppLigne
 
With Me.ListView1
.ListItems.Remove .SelectedItem.Index
Worksheets("consignes").Rows(SuppLigne).Delete Shift:=xlUp
End With
    Application.ScreenUpdating = True
End Sub

**unparia** · 15/03/2017, 15h39

S'agit-il d'une troisième difficulté distincte dans la même discussion (ouverte à d'autres fins) ?
Quelle sera la prochaine, si l'on résout celle-ci également ?

Filtre ListView avec deux combobox

Macros et VBA Excel

Discussions similaires

Partager

Partager