Dtpicker et combobox pour filtrage dans un listbox
Bonjour tout le monde j'ai un probleme dans mon code vba
je veux filtrer et afficher dans une listbox les données d'un tableau en fonction de deux criteres de combobox et une plage date Dtpicker (deux Dtpicker)
j'ai reussi a filtrer en fonction des combobox mais ca beug en voulant ajouter le code de filtrage de DTpicker
je vous joint mon fichier le code est dans le userform 'tirage'
voici mon code :
Dim BD(), Ncol
Dim keys As Long
Dim f As Worksheet
Private Sub ComboBox1_Change()
'With Worksheets("Historique des Demandes")
affichelist
End Sub
Private Sub ComboBox2_Change()
affichelist
End Sub
Private Sub CommandButton1_Click()
Dim lindex As Long
Randomize
If ListBox1.ListCount Then
lindex = Int(Rnd * ListBox1.ListCount)
TextBox1.Text = ListBox1.List(lindex)
ListBox1.RemoveItem lindex
Else: MsgBox ("la liste est vide: veuillez entrer un nouveau choix ")
End If
End Sub
Private Sub CommandButton2_Click()
Dim f
Dim debut As Date
Dim fin As Date
Set f = Sheets("Historique des Demandes")
debut = DTPicker1.Value
fin = DTPicker2.Value
f.Range("$A$1:K2000").AutoFilter field:=3, Criteria1:=">=" & debut, Operator:=xlAnd, Criteria2:="<=" & fin
Me.ListBox1.AddItem
End Sub
Private Sub CommandButton3_Click()
Selection.AutoFilter field:=3
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub TextBox1_Change()
End Sub
Private Sub UserForm_Initialize()
Dim d
Dim I As Integer
Dim temp
Set f = Sheets("Historique des Demandes")
'BD = f.Range("A2:G" & f.[A65000].End(xlUp).row).Value
BD = f.Range("A2:K" & f.[a65000].End(xlUp).row).Value
Ncol = UBound(BD, 2)
'--- combobox Statuts tri?
Set d = CreateObject("Scripting.Dictionary")
d("**************") = ""
For I = LBound(BD) To UBound(BD)
If BD(I, 7) <> "" Then
d(BD(I, 7)) = ""
End If
Next I
temp = d.keys
'Tri temp, LBound(temp), UBound(temp)
Me.ComboBox1.List = temp
Me.ComboBox1.ListIndex = 0
'--- combobox TypeDem tri?
Set d = CreateObject("Scripting.Dictionary")
d("**************") = ""
For I = LBound(BD) To UBound(BD)
d(BD(I, 5)) = ""
Next I
temp = d.keys
'Tri temp, LBound(temp), UBound(temp)
Me.ComboBox2.List = temp
Me.ComboBox2.ListIndex = 0
affichelist
End Sub
Sub affichelist()
Dim statut
Dim TypeDem
Dim n, I, K, J
Dim Tbl()
statut = Me.ComboBox1
TypeDem = Me.ComboBox2
n = 0
For I = 1 To UBound(BD)
If BD(I, 7) Like statut And BD(I, 5) Like TypeDem Then
n = n + 1: ReDim Preserve Tbl(1 To Ncol, 1 To n)
For K = 1 To Ncol: Tbl(K, n) = BD(I, K): Next K
End If
Next I
If n > 0 Then
Me.ListBox1.Column = Tbl
Me.Label3.Caption = "Votre choix affiche " & Me.ListBox1.ListCount & " demande(s)"
' ListBox1.List = Selection.SpecialCells(xlCellTypeVisible).Value
' ListBox1.List = Range("A1:L10000").Value
Else
Me.ListBox1.Clear
Me.Label3.Caption = ""
End If
End Sub
Bonsoir,
Houlala !
Faut être maso pour lire ça !
Bonjour,
Origine du code (sur quel site)?
Ceuzin
malheureusement je ne peux pas mettre le fichier c est confidentiel
Si c'est malheureux, ne te prive pas de pleurer !