Discussion :

[Ludmillast]

Bonjour,

une nouvelle fois, je sollicite votre aide pour résoudre un problème dans ma programmation.
Je cherche à créer un moteur de recherche qui, à l'aide de 5 critères, me permet de sortir une liste de résultats dans une listbox.
Les critères sont dans des combobox (dans un formulaire qui s'ouvre à partir d'un bouton sur ma feuille excel) remplis à partir d'un tableau excel qui me sert de base de données.
Pas de problème pour remplir les combo par ordre alphabétique et sans doublons. Mais quand je valide mes critères, rien de s'affiche.

Voici mon code :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
Option Explicit
 
Private Sub Cb_Annuler_Click()
Unload Me
End Sub
Private Sub Cb_Valider_Click()
Dim TB
Dim Lig As Long, DerLig As Long, i As Integer
    Label6.Visible = False
    TB = Array(Cb_Produits, Cb_Fabricant, Cb_Fournisseur, Cb_FamilleProd, Cb_SousFamilleProd)
    Lt_Resultat.Clear
    With Sheets("ProdChim2") 'Pas changer le nom
        DerLig = .Cells(65536, 2).End(xlUp).Row
        For Lig = 8 To DerLig
            For i = 0 To UBound(TB)
                If TB(i) <> "Tous" Then
                    If TB(i) <> .Cells(Lig, i + 1) Then Exit For
                End If
            Next i
            If i > UBound(TB) Then
            'Mettre la ligne trouvée dans la listBox
            Lt_Resultat.AddItem
                For i = 0 To 4:
                    Lt_Resultat.List(Lt_Resultat.ListCount, i) = .Cells(Lig, i + 1)
                Next i
            End If
        Next Lig
        End With
        If Lt_Resultat.ListCount = 0 Then Label6.Visible = True
End Sub
 
 
Private Sub UserForm_Initialize()
Dim i As Integer, B As Boolean, Lg As String, L As Integer
Dim Lig As Long, DerLig As Long
    'Positionne le titre
    lbl_titre.Move 0, 0, Me.Width
    'Largeur colonne Lt_result
    L = (Lt_Resultat.Width / 5) - 2
    For i = 0 To 5: Lg = Lg & CStr(L) & ";": Next i
    Lt_Resultat.ColumnWidths = Lg
    'Remplir les combo
    With Sheets("ProdChim2") 'Pas changer le nom
        DerLig = .Cells(65536, 2).End(xlUp).Row
        For Lig = 8 To DerLig
            Cb_Produits.AddItem .Cells(Lig, 2)
            If .Cells(Lig, 3) <> "" Then
                Cb_Fabricant.AddItem .Cells(Lig, 3)
            End If
            If .Cells(Lig, 4) <> "" Then
                Cb_Fournisseur.AddItem .Cells(Lig, 4)
            End If
            If .Cells(Lig, 6) <> "" Then
                Cb_SousFamilleProd.AddItem .Cells(Lig, 6)
            End If
        Next Lig
    End With
    With Sheets("ListesFormulaire") 'Pas changer le nom
        i = 4
        While .Cells(i, 1) <> ""
            Cb_FamilleProd.AddItem .Cells(i, 1)
            i = i + 1
        Wend
    End With
    'Mettre par ordre alphabétique et enlève les éventuel doublons
    Alpha Cb_Produits: OteDB Cb_Produits
    Alpha Cb_Fabricant: OteDB Cb_Fabricant
    Alpha Cb_Fournisseur: OteDB Cb_Fournisseur
    Alpha Cb_SousFamilleProd: OteDB Cb_SousFamilleProd
    'Quand il n'y a pas de critère Tous doit être sélectionner.
    Cb_Produits.AddItem "Tous", 0: Cb_Produits.ListIndex = 0
    Cb_Fabricant.AddItem "Tous", 0: Cb_Fabricant.ListIndex = 0
    Cb_Fournisseur.AddItem "Tous", 0: Cb_Fournisseur.ListIndex = 0
    Cb_FamilleProd.AddItem "Tous", 0: Cb_FamilleProd.ListIndex = 0
    Cb_SousFamilleProd.AddItem "Tous", 0: Cb_SousFamilleProd.ListIndex = 0
End Sub
Sub Alpha(CB As ComboBox)
Dim i As Integer, B As Boolean, Buff
Reco:
    B = False
    For i = 0 To CB.ListCount - 2
        If CB.List(i) > CB.List(i + 1) Then
            Buff = CB.List(i + 1): CB.List(i + 1) = CB.List(i)
            CB.List(i) = Buff: B = True
        End If
    Next i
    If B Then GoTo Reco
End Sub
Sub OteDB(CB As ComboBox)
    Dim i As Integer
    For i = CB.ListCount - 1 To 1 Step -1
        If CB.List(i) = CB.List(i - 1) Then
            CB.RemoveItem (i)
        End If
    Next i
End Sub

Je vous mets en PJ mon tableau source pour vous donner une idée de sa structure.
Par contre, les macros ne sont pas exploitables directement sur le fichier joint car il est extrait de ma base de données.

Si quelqu'un a une idée du problème, je prends.

Merci d'avance !