Filtre automatique

[Max Diack]

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 Gros Dé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.

 

[Laurent]

Bonjour Max Diack,

Je n'ai pas de réponse précise pour corriger ton code mais plutot un lien vers un fil qui m'a bien aidé quand j'ai été comme toi confronté aux problèmes de filtre automatique.
Je te conseil l'excellente démo du non moins excellent @+Thierry qu'il a nommé: USF-Cascade-Combo-ReportV3.01.zip qui résout le genre de bug que tu obtiens.

<http://www.excel-downloads.com/html/French/forum/messages/1_26671_26671.htm>

Soit patient, le fil est un des plus long qu'il m'ait été donné de voir sur ce site.

En espérant t'avoir rendu service. Bon courage

Laurent

 

[@+Thierry]

Bonjour Laurent, Max le Forum

Ah hier soir je n'avais pas vu que Max nous doublonnais sa question sinon, je lui aurais conseillé ce lien => Charte car ce n'est pas du tout "XLD-Compliant".

Toutefois donc je lui ai aussi répondu dans l'autre => Lien supprimé

Mais sinon, celà aura donné l'occasion à Laurent de t'envoyer sur un sacré Fil aussi. (Je crois de mémoire qu'on étéit allé même jusqu'à la V4) et aussi je profite à mon tour pour te féliciter, Laurent, pour ton travail et te remercier pour ta gentillesse.

Bonne Journée (TGIF !)
@+Thierry