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
| 'Renseigne les 10 combos. Critere correspond à une sélection dans un ComboBox
'Combo correspond au N° du combo dans l'userform
'Si pas de critere ni No de combo => Pas de filtre
'Sinon => Filtre sur la colonne ListCol(combo)
Sub Rechercher(Critere As String, Combo As Integer)
Dim ListCol As Variant, NoLig As Long, NoCol As Integer, Colonne As String
Dim Plage As Range, Cell As Range, DerLig As Long
ListCol = Array(, 1, 2, 4, 5, 6, 7, 8, 9, 10, 13)
'Le fait de renseigner une liste sans doublon provoque l'événement Change
'INIT permet de neutraliser cet événement
INIT = True
DerLig = Split(FL1.UsedRange.Address, "$")(4)
If FL1.FilterMode = True Then FL1.Cells.AutoFilter
If Combo <> 0 Then
Colonne = FL1.Columns(ListCol(Combo)).Address(0, 0)
If Err.Number <> 0 Then
Err.Clear
On Error GoTo 0
FL1.Columns(Colonne).AutoFilter Field:=1, Criteria1:=CDbl(Critere)
Else
FL1.Columns(Colonne).AutoFilter Field:=1, Criteria1:=Critere
End If
End If
'Définit la plage selon le critère de filtre. Si pas de critère, pas de filtre
For NoCol = 1 To 10
If Not Critere = "" Then
DoEvents
On Error Resume Next '[*]Gestion d'erreur
Set Plage = FL1.Range(Cells(2, ListCol(NoCol)), Cells(DerLig, ListCol(NoCol))).SpecialCells(xlCellTypeVisible)
If Err.Number = 1004 Then Exit For
Else
DerLig = Split(FL1.UsedRange.Address, "$")(4)
Set Plage = FL1.Range(Cells(2, ListCol(NoCol)), Cells(DerLig, ListCol(NoCol)))
End If
Me.Controls("RechercheC" & NoCol).Clear
Me.Controls("RechercheC" & NoCol).AddItem "" 'Place une ligne vide ds le combo
'Renseigne les dix combobox
For Each Cell In Plage
If Trim(Cell) <> "" Then
Me.Controls("RechercheC" & NoCol) = Cell
If Me.Controls("RechercheC" & NoCol).ListIndex = -1 Then _
Me.Controls("RechercheC" & NoCol).AddItem Cell
End If
Next
Me.Controls("RechercheC" & NoCol).ListIndex = 0
Next
If Err.Number = 1004 Then Rechercher Critere, Combo
INIT = False
initialisation (Critere) 'Renseigne le combo ListBoxParquet
End Sub |