VBA - Filtrer ListView selon choix dans deux combobox

Wassss

XLDnaute Nouveau
Bonjour,
je viens à vous pour demander de l'aide,

j'ai une listview1 qui se rempli selon choix de mon combobox1 , je veux dans un deuxième temps filtrer (pas trier) le contenu de ma listview1 selon la colonne "Date" (de ma listview1) avec mon combobox2

Fichier Listview1.xlsm : ne contient que ma listview1
Fichier Bordereau Stock v3.xlsm : contient tout mon projet


je vous remercie d'avance
 

Pièces jointes

  • Listview1.xlsm
    28.6 KB · Affichages: 448
  • Listview1.xlsm
    28.6 KB · Affichages: 545
  • Listview1.xlsm
    28.6 KB · Affichages: 571
  • Bordereau Stock v3.xlsm
    91.7 KB · Affichages: 498

Bebere

XLDnaute Barbatruc
Re : VBA - Filtrer ListView selon choix dans deux combobox

Bonjour Wasss
bienvenue
un exemple par patient ou par date
à bientôt
 

Pièces jointes

  • Listview1.xlsm
    28 KB · Affichages: 1 139
  • Listview1.xlsm
    28 KB · Affichages: 1 040
  • Listview1.xlsm
    28 KB · Affichages: 968

Wassss

XLDnaute Nouveau
Re : VBA - Filtrer ListView selon choix dans deux combobox

Bonjour Bebere et le Forum ,
votre exemple marche a merveille merci beaucoup :) parcontre le choix de mon combobox2 ne prend pas en compte le premier choix de mon combobox1 , si je choisie dans combobox1 la fiche "1" , puis je choisie dans combobox2 la date "01/06/2012" , la listview m'affiche toutes les lignes avec cette date et ne prend pas en compte le filtre par fiche de combobox1 .

j'ai trouvé aussi un code sur le forum pour modifier une ligne sélectionnée dans ma listview , je l'ai adapté a mon fichier , je rencontre malheureusement pour moi une erreur de type "Index out of bounds" , cette ligne de code semble l'origine de l'erreur :
Code:
x = ListView1.ListItems(lvwLigne).ListSubItems(7).Text

voici mon code complet :

Code:
Dim Autorise As Boolean 'libère ou coince l'accès au contrôle ListView, ne pas déplacer
Dim tablo, i As Integer


'Private Sub CommandButton1_Click()
'Unload Me
'Sheets("Mvts").Select
'UserForm6.Show
'End Sub


Private Sub Label3_Click()

End Sub


Private Sub ListView1_BeforeLabelEdit(Cancel As Integer)

End Sub



Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Dim lvwLigne As Long, i As Byte
lvwLigne = ListView1.SelectedItem.Index
    TextBox1 = ListView1.ListItems(lvwLigne).Text
        For i = 1 To ListView1.ColumnHeaders.Count - 1
            Controls("TextBox" & i + 1) = ListView1.ListItems(lvwLigne).ListSubItems(i).Text
        Next

End Sub



Private Sub UserForm_Initialize()
  Dim Vcol As Byte, Colonne(7) As Byte, vC As Range, vLi As Long
   Dim data As Object

ThisWorkbook.Sheets("Mvts").Activate
  With ListView1
  tablo = Range("a3:g" & Range("a65536").End(xlUp).Row)

    With .ColumnHeaders
      For Vcol = 1 To 1
        .Add , , Cells(2, Vcol), Cells(2, Vcol).Width 'Wcol(Vcol - 1)
      Next
      For Vcol = 2 To 7
        .Add , , Cells(2, Vcol), Cells(2, Vcol).Width, lvwColumnCenter
      Next
    End With
 
    .Gridlines = True
    .Font.Size = 15
    .Sorted = False
    .FullRowSelect = True
    .ListItems.Clear
    .View = lvwReport
    'largeurs
  End With
  
'    Wcol = Array(60, 160, 50, 30, 110, 30, 60)
'    For Vcol = 0 To 6
'      Colonne(Vcol) = Wcol(Vcol)
'    Next

Set data = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(tablo)
If Not data.Exists(tablo(i, 5)) Then data.Add tablo(i, 5), tablo(i, 5)
Next i
ComboBox1.List = data.items

Set data = CreateObject("Scripting.Dictionary")

For i = 1 To UBound(tablo)
If Not data.Exists(tablo(i, 1)) Then data.Add tablo(i, 1), tablo(i, 1) 'dates
Next i
ComboBox2.List = data.items


    'passage par ListView pour trier
'    For Each vC In Sheets("Mvts").Range("D3:D" & [D65000].End(xlUp).Row).SpecialCells(xlCellTypeVisible)
'      Set vItem = .ListItems.Add(, , vC)
'    Next
'    For vLi = 1 To .ListItems.Count
'      ComboBox1 = .ListItems(vLi)
'      If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem .ListItems(vLi)
'    Next
'    ComboBox1 = ""
'    .ListItems.Clear
'  Autorise = True
End Sub
Private Sub ComboBox1_Change()
  If ComboBox1 <> "" Then
  Dim vItem As ListItem, vLi As Integer
  With ListView1
    .ListItems.Clear
For i = 1 To UBound(tablo, 1)
   If tablo(i, 5) = ComboBox1 Then
        Set vItem = .ListItems.Add(, , tablo(i, 1))
        For Vcol = 2 To UBound(tablo, 2)
          vItem.ListSubItems.Add , , tablo(i, Vcol)
        Next
      End If
    Next
    
  End With
     End If
 ComboBox1.DropDown
If (ListView1.ListItems.Count <> 0) Then
    'If ListView1.ListItems.Count <> 0 Then
    ListView1.ListItems(ListView1.ListItems.Count).EnsureVisible
    'ListView1.ListItems(ListView1.ListItems.Count).Selected = True
    'ListView1.SetFocus
    End If
End Sub
Private Sub ComboBox2_Change()
  If ComboBox2 <> "" Then
  Dim vItem As ListItem, vLi As Integer
  With ListView1
    .ListItems.Clear
For i = 1 To UBound(tablo, 1)
   If tablo(i, 1) = CDate(ComboBox2) Then
        Set vItem = .ListItems.Add(, , tablo(i, 1))
        For Vcol = 2 To UBound(tablo, 2)
          vItem.ListSubItems.Add , , tablo(i, Vcol)
        Next
      End If
    Next
  End With
     End If
ComboBox2.DropDown
If (ListView1.ListItems.Count <> 0) Then
    'If ListView1.ListItems.Count <> 0 Then
    ListView1.ListItems(ListView1.ListItems.Count).EnsureVisible
    'ListView1.ListItems(ListView1.ListItems.Count).Selected = True
    'ListView1.SetFocus
    End If
End Sub


Private Sub Modifier_Click()
Dim vItem As ListItem, lvwLigne As Long, i As Byte, x As Long
On Error Resume Next
Set vItem = ListView1.SelectedItem
On Error GoTo 0
If vItem Is Nothing Then
    MsgBox "Aucune ligne n'est sélectionnée."
    Exit Sub
End If
lvwLigne = ListView1.SelectedItem.Index
'message falcultatif avant modif
If MsgBox("Modifier ?!", vbCritical + vbYesNo) = 6 Then
    With ListView1
        .ListItems(lvwLigne).Text = TextBox1
            For i = 1 To 6
                .ListItems(lvwLigne).ListSubItems(i).Text = Controls("TextBox" & i + 1)
            Next
    End With
    x = ListView1.ListItems(lvwLigne).ListSubItems(7).Text
    With Sheets("Mvts")
        .Cells(x, 1) = CDate(TextBox1)
        For i = 2 To 7
            .Cells(x, i) = Controls("TextBox" & i)
        Next
        .Cells(x, 7) = CDate(TextBox7)
    End With
End If
End Sub


'Sub EffaceTout() 'effacement éventuel des textbox
'Dim i As Byte
'For i = 1 To 7
'    Controls("TextBox" & i) = ""
'Next
'
'End Sub

est ce que vous pouvez m'aider svp ? je vous remerci d'avance
 

Pièces jointes

  • modifier listview.xlsm
    38.8 KB · Affichages: 457
  • modifier listview.xlsm
    38.8 KB · Affichages: 592
  • modifier listview.xlsm
    38.8 KB · Affichages: 602
Dernière édition:

Bebere

XLDnaute Barbatruc
Re : VBA - Filtrer ListView selon choix dans deux combobox

Was
le fichier avant était un exemple
dans listview emploi des clés(Key)plus performantes
pour mettre les données dans feuille aussi
il y a moyen de faire autrement
ce que tu tapes dans les textbox va directement dans listview
ensuite modifier pour mettre dans feuille
à bientôt
 

Pièces jointes

  • modifier listview.xlsm
    35.7 KB · Affichages: 915
  • modifier listview.xlsm
    35.7 KB · Affichages: 1 084
  • modifier listview.xlsm
    35.7 KB · Affichages: 1 241

Wassss

XLDnaute Nouveau
Re : VBA - Filtrer ListView selon choix dans deux combobox

bonsoir bebere et merci pour ton aide precieuse ,

j'ai pas compris "emploi des clés(Key)plus performantes pour mettre les données dans feuille" ? je suis novice en excel et en vba mais j'essaie d'apprendre

par exemple dans votre dernier essaie j'ai enlevé < ComboBox1 = "": ComboBox2 = "" > pour pouvoir selectionner une autre date pour le meme patient a partir de conbobox2 sans etre obligé de repasser par combobox1 :D

par contre quand je veux modifier une ligne sélectionnée dans ma listview , j'ai une erreur "Incompatibilité de Type" sur cette ligne de code :
Code:
.Range(Clé) = CDbl(ListView1.ListItems(lvwLigne).ListSubItems(Clé).Text)

tien elle ressemble a la ligne de code qui a causé l'erreur "Index out of bounds" que j'ai evoqué dans mon message precedent :
Code:
x = ListView1.ListItems(lvwLigne).ListSubItems(7).Text

c'est louche cette histoire .. ça ne viendrait pas de ma version excel (2010) par hasard ?
 
Dernière édition:

Discussions similaires

Réponses
13
Affichages
342

Statistiques des forums

Discussions
311 720
Messages
2 081 909
Membres
101 836
dernier inscrit
karmon