Filtre automatique bis

Bonjour à tout le forum
Je tente de filtrer un tabeau grace à un userfom(idée tiré d'un model de @Thiery, que j'avais téléchargé su ce site).
Disposition des cellulles A1:F1 =
Rf Dates Produits GrosDétail Montant
et le code est le suivant:

Option Explicit
Public ColNum As Integer
Public ColLet As String
Public Critere As String

Private Sub Label2_Click()

End Sub

'Thierry's Macro Demo sur www.Excel-Downloads.com
'================================================= ================
'BETA TEST VERSION......... 26/11/2002...........BETA TEST VERSION
'================================================= ================

Private Sub UserForm_Initialize()
Worksheets(1).AutoFilterMode = False
CommandButton1.Visible = False
ListBox1.AddItem ("Dates")
ListBox1.AddItem ("Produits")
ListBox1.AddItem ("Gros")
ListBox1.AddItem ("Détail")
ListBox1.AddItem ("Produits")
Label2.Caption = ""
End Sub

Private Sub ListBox1_Click()
Initialise
Dim NBLigne As Integer
Dim PlageFiltre As String
NBLigne = Sheets(1).Range(ColLet & "65536").End(xlUp).Row
PlageFiltre = Sheets(1).Range(ColLet & "2:" & ColLet & NBLigne).Address
ListBox2.RowSource = "DATABASE!" & PlageFiltre
End Sub
Sub Initialise()
Dim ChoixCol As String
ChoixCol = ListBox1.Text
ListBox3.Clear
Label2.Caption = ""
Select Case ChoixCol
Case "Dates"
ColNum = 1
ColLet = "A"
Case "Produits"
ColNum = 2
ColLet = "B"
Case "Gros"
ColNum = 3
ColLet = "C"
Case "Détail"
ColNum = 4
ColLet = "D"
Case "Montant"
ColNum = 5
ColLet = "E"
End Select

End Sub
Private Sub ListBox2_Click()
'Initialise
ListBox3.Clear
Label2.Caption = ""
CommandButton1.Visible = True
End Sub
Private Sub CommandButton1_Click()
Dim Critere As String
Dim cell As Range
Dim r As Range
Dim i As Integer
Dim tabT() As String
Dim w As Worksheet
Set w = Worksheets(1)
Critere = ListBox2.Value
ListBox3.Clear

If w.AutoFilterMode Then
w.AutoFilterMode = False
w.Range("A1").AutoFilter ColNum, Critere
Else
w.Range("A1").AutoFilter ColNum, Critere
End If

Set r = Sheets(1).Range("A1", [A65536].End(xlUp))
Set r = r.SpecialCells(xlCellTypeVisible)
ReDim tabT(0 To r.Count - 1)
For Each cell In r
tabT(i) = cell.Value
i = i + 1
Next
Me.ListBox3.List = tabT
Me.Label2.Caption = r.Count - 1
End Sub

Private Sub CommandButton2_Click()
Unload UserForm1
Worksheets(1).AutoFilterMode = False
End Sub

Mais à chaque fois que j'essai de le filtrer par date il me renvoi un message d'erreur 6. i= i+1 est maqué en jaune dans l'utilitaire de débbogage
Pouvez vous m'aider à résoudre ce probléme .

Merci d'avance.

Bonsoir Max, le Forum

Si je me souviens de ce UserForm AutoFilterenVBA.zip du 26/11/2002 (ça rajeunit pas !!) il ne s'agissait pas de filtrer les dates...

Donc en fait tout dépend de ce que tu as dans ta ListBox2... Et j'ai bien peur que les Dates ne soient pas "vues" par l'AutoFilter tel que ceci... Et donc le tabT ne peut être incrémenté si l'AutoFilter ne retourne aucun date... C'est à dire aucun enregistrement Filtré... Et donc le i peut tourner jusqu'au dépassement de capacité (Erreur 6)....

Alors le problème c'est que l'on peut déclarer le Critère comme étant défivement une Date comme ceci :

Dim Critere As Date 'à la place de String
Critere = CDate(ListBox2.Value)

Là ce devrait marcher pour filtrer sur une Date.......Mais vu que ce UserForm peut aussi Filtrer des "Produits", des "Gros" (mais qui est gros !! lol), des "Détail" et des "Produits"(encore).... Là tu sera coincé car le Critère ne sera évidemment plus une Date...

Donc il n'y a pas de solution toute simple... J'ai fait rapidement différents essais, mais si je passe "Critère" As Variant, la Date n'est pas bien retournée... Et erreur 6 de nouveau... Donc pas de solution, si ce n'est de faire une procédure indépendante pour toute recherche de filtre par Date.

Désolé et bon courage et bonne soirée, journée
@+Thierry

salut,
un macro pour filtrer des dates t'aideras peut être


Attribute VB_Name = "FiltreAutoSurCritereDate"

'Ci-joint une macro qui permet de filter une base ( Mode filtre automatique )
'sur un critère de date, et ce quelque soit le format utilisé.
'Philippe Muniesa, mpfe
'dans les commentaires : Catherine = C. Copigny, Laurent = L. Longre

'Soit la Base ( extrait)

' Compte Date
'627000000 30.03.00
'580000001 30.03.00
'512062000 30.03.00
'530000000 30.03.00
'401020600 31.03.00
'455000000 31.03.00
'512062000 31.03.00
'758000000 28.02.00
'758000000 28.02.00

Sub filtre_auto_sur_dates()

'=== La colonne 2 est la colonne qui contient les dates,
'=== un appel de cette macro si la cellule
'=== Active n'est pas dans la colonne 2 génère un message.
'=== Le plus simple est d'appeler cette
'=== Macro avec un évenement doubleclick ou Rightclick sur la feuille
'=== avec un : IF ACTIVECELL.COLUMN = 2 then Filtre_auto_sur_dates

If ActiveCell.Column <> 2 Then
MsgBox ("le curseur doit être dans la colonne 2")
Exit Sub
End If

'=== Par mesure de précaution, la colonne est reformatée
'=== selon le format d'affichage désiré (Merci catherine :-)
'=== en effet l'utilisateur pourrait changer le format de certaines
'=== cellules de la colonne et dans
'=== ce cas, le filtre serait incomplet ( c'est Laurent qui l'a dit)

ActiveCell.EntireColumn.NumberFormat = "dd.mm.yy"
'Ou un autre format, là c'est vous qui voyez


'=== Les critères un et deux de selection sont etablis
'=== en fonction du format de la cellule active.

Criter1 = Format$(ActiveCell, ActiveCell.NumberFormat)

'=== Le critère 2 est dans cet Exemple Fixe, mais il peux provenir d'une
'=== autre cellule ou d'une Saisie par l'utilisateur

Criter2 = Format$("30.03.00", ActiveCell.NumberFormat)

'Et la syntaxe du Filtre communiqué par Laurent toute simple avec

Selection.AutoFilter ActiveCell.Column, Criter1, xlOr, Criter2

End Sub


'==============


je l'ai trouvé sur le Site de F Sigionneau

http://frederic.sigonneau.free.fr/code/Tris/FiltreAutoSurCritereDate.txt

@+