recherche en cascade dans UserForm

Question

Bonjour, 

Je débute dans la programmation VBA !!!
Je souhaite faire une recherche en cascade dans un UserForm2 afin d'afficher les données d'une base elle même alimentée par un premier UserForm1 ( celui là j'ai réussi)



La recherche porte sur  le pavé Apport en bleu: recherche par Portefeuille, puis par Statut.
J"ai également mis un bouton de défilement pour visualiser les résultats en cas de multiples réponses à la recherche


Le but étant de récupérer les données dans la partie gauche du UserForm2 (qui correspond à la saisie du UserForm1)

Et dans un 2eme temps compléter la base de données avec les champs "Date", "Issue" et "Commentaires" (Pavé Statut) sans créer une nouvelle ligne

Je précise que les UserForm1 et UserForm2 sont accessibles depuis une feuille "Menu" alors que la base est dans une feille "LBP"

Est ce quelqu'un a un début de réponse?

Merci pour vos conseils...

Dommage que je ne puisse joindre le fichier Xls

fairway111 · Answer

Avec le fichier c'est plus explicite
fichier supprimé pour anonymat

pijaku · Answer

Bonjour,

Il manque des infos...
recherche par Portefeuille, puis par Statut 
Feuille LBP, ==> pas de colonne "Statut".

fairway111 · Answer

Bonsoir,

En fait la colonne Issue est aussi la colonne Statut
Par défaut, le  UserForm1 met par défaut "En attente" dans la colonne Issue.
Le UserForm2 modifie l'issue dans le pavé Statut.

J'ai pu me faire aider pour coder le UserForm2 et faire cette fameuse recherche en cascade.
Vraiment bien au dessus de mes compétences actuelles !! 

Encore merci pour ton aide et la considération qui tu apportes à mes question.

Surement à une autre fois .. j'ai des projets similaires en cours...

Bonne soirée.

fairway111 · Answer

Ci dessous le code correspondant:

Option Explicit

Private mcolApports As Collection
Private moShLBP As Worksheet
Private miNumRes As Integer 'n° du résultat

Private Sub cboPtf_Click()
    'V0.2
    RAZ
    'V0.2-fin
    'Rechercher
End Sub

Private Sub cboStatuts_Click()
    'V0.2
    RAZ
    'V0.2-fin
    'Rechercher
End Sub

Private Sub cmdRechercher_Click()
    'V0.2
    RAZ
    'V0.2-fin
    Rechercher
End Sub

Private Sub cmdValider_Click()

If Not IsDate(txtIssueDate.Text) Then
        MsgBox "Date incorrecte !" & vbCrLf & txtIssueDate.Text, vbExclamation
        Exit Sub
    End If
    
    Valider
    
End Sub

Private Sub Valider()

Dim iLigBDP As Integer
    Dim oApport As clsApport
    
    Set oApport = mcolApports(miNumRes)
    iLigBDP = oApport.NumLigneLBP
    Set oApport = Nothing
    
    moShLBP.Range("K" & iLigBDP).Value = txtIssueDate.Text
    moShLBP.Range("L" & iLigBDP).Value = txtIssueLib.Text
    moShLBP.Range("M" & iLigBDP).Value = txtIssueComment.Text
    
End Sub
Private Sub CommandButton2_Click()
    UserForm2.PrintForm
    
End Sub

Private Sub CommandButton4_Click()
    Unload UserForm2
End Sub

Private Sub Rechercher()

Dim iLig As Integer
    Dim iDerLig As Integer
    Dim bGarder As Boolean
    Dim oApport As clsApport
    
    Set mcolApports = Nothing
    Set mcolApports = New Collection
    
    iDerLig = moShLBP.Range("A" & 65000).End(xlUp).Row
    
    For iLig = 3 To iDerLig
        If moShLBP.Range("L" & iLig).Value = cboStatuts.Value Or cboStatuts.Value = "" Then
            bGarder = True
        Else
            bGarder = False
        End If
        If bGarder Then
            If moShLBP.Range("J" & iLig).Value = cboPtf.Value Or cboPtf.Value = "" Then
                bGarder = True
            Else
                bGarder = False
            End If
        End If
        If bGarder Then
            Set oApport = New clsApport
            oApport.NumLigneLBP = iLig
            oApport.Apporteur = moShLBP.Range("A" & iLig).Value
            oApport.DateApport = moShLBP.Range("B" & iLig).Value
            oApport.Nom = moShLBP.Range("C" & iLig).Value
            oApport.Prenom = moShLBP.Range("D" & iLig).Value
            If IsDate(moShLBP.Range("E" & iLig).Value) Then
                oApport.DateNaissance = moShLBP.Range("E" & iLig).Value
            End If
            oApport.Telephone = moShLBP.Range("F" & iLig).Value
            oApport.MotifRDV = moShLBP.Range("G" & iLig).Value
            oApport.DateRDV = moShLBP.Range("H" & iLig).Value
            oApport.Commentaires = moShLBP.Range("I" & iLig).Value
            oApport.Conseiller = moShLBP.Range("J" & iLig).Value
            oApport.IssueDate = moShLBP.Range("K" & iLig).Value
            oApport.IssueLibelle = moShLBP.Range("L" & iLig).Value
            oApport.IssueCommentaires = moShLBP.Range("M" & iLig).Value
            mcolApports.Add oApport
            Set oApport = Nothing
        End If
    Next iLig
    
    If mcolApports.Count = 0 Then
        MsgBox "Aucun résultat !", vbExclamation
        SpinButton1.Enabled = False
        Exit Sub
    End If
    
    SpinButton1.Enabled = True
    'positionnement sur le premier
    miNumRes = 1
    
    AfficherApport
    
End Sub

'V0.2
Private Sub RAZ()

txtApporteur.Text = ""
    txtDateApport.Text = ""
    txtClientComment.Text = ""
    txtClientDatRDV.Text = ""
    txtClientDtNaiss.Text = ""
    txtClientMotifRDV.Text = ""
    txtClientNom.Text = ""
    txtClientPrenom.Text = ""
    txtClientTel.Text = ""
    txtConsPtf.Text = ""
    txtIssueComment.Text = ""
    txtIssueDate.Text = ""
    txtIssueLib.Text = ""
    
End Sub

Private Sub AfficherApport()

Dim oApport As clsApport
    
    Set oApport = mcolApports(miNumRes)
    'V0.2
    txtApporteur.Text = oApport.Apporteur
    txtDateApport.Text = oApport.DateApport
    'V0.2-fin
    txtClientComment.Text = oApport.Commentaires
    txtClientDatRDV.Text = oApport.DateRDV
    txtClientDtNaiss.Text = oApport.DateNaissance
    txtClientMotifRDV.Text = oApport.MotifRDV
    txtClientNom.Text = oApport.Nom
    txtClientPrenom.Text = oApport.Prenom
    txtClientTel.Text = oApport.Telephone
    txtConsPtf.Text = oApport.Conseiller
    txtIssueComment.Text = oApport.IssueCommentaires
    If oApport.IssueDate = "00:00:00" Then
        txtIssueDate.Text = ""
    Else
        txtIssueDate.Text = oApport.IssueDate
    End If
    txtIssueLib.Text = oApport.IssueLibelle
    Set oApport = Nothing
    Label25.Caption = miNumRes & "/" & mcolApports.Count
    
End Sub

Private Sub Frame1_Click()

End Sub

Private Sub Label24_Click()

End Sub

Private Sub Label25_Click()

End Sub

Private Sub Recherche_Click()
    Rechercher
End Sub

'V0.2
'Private Sub SpinButton1_Change()
'
'    If SpinButton1.Value = 0 Then
'        If miNumRes = 1 Then
'            MsgBox "Premier enregistrement !", vbExclamation
'            Exit Sub
'        Else
'            miNumRes = miNumRes - 1
'        End If
'    Else
'        If miNumRes = mcolApports.Count Then
'            MsgBox "Dernier enregistrement !", vbExclamation
'            Exit Sub
'        Else
'            miNumRes = miNumRes + 1
'        End If
'    End If
'
'End Sub

'V0.2
Private Sub SpinButton1_SpinDown()

If miNumRes = 1 Then
        MsgBox "Premier apport !", vbExclamation
        Exit Sub
    Else
        miNumRes = miNumRes - 1
    End If
    
    AfficherApport

End Sub

'V0.2
Private Sub SpinButton1_SpinUp()

If miNumRes >= mcolApports.Count Then
        MsgBox "Dernier apport !", vbExclamation
        Exit Sub
    Else
        miNumRes = miNumRes + 1
    End If
    
    AfficherApport
    
End Sub

Private Sub txtClientMotifRDV_Change()

End Sub

Private Sub UserForm_Initialize()
    Set moShLBP = Worksheets("LBP")
End Sub

Private Sub UserForm_Terminate()
    Set mcolApports = Nothing
    Set moShLBP = Nothing
End Sub

pijaku · Answer

Bon, voici un autre exemple.
La méthode est certainement plus aisée à aborder.
Dis moi ce qu'il en est.

Le classeur exemple : https://www.cjoint.com/c/FCco7zlJqxE

Le code

Option Explicit
Option Base 1

'1- Stocker toutes les valeurs de la feuille dans une variable tableau
    'cela implique de créer une fonction qui va  :
        '=> prendre toutes les valeurs de la feuille,
        '=> les stocker dans une variable tableau
        '=> contrôler cette variable tableau :
            '- contient-elle réellement des valeurs?

'2- Création d'une fonction de recherche :
    'Cette fonction va alimenter un variable tableau Lignes()
    'des numéros de lignes correspondants à la recherche.
    'Elle va également tenir compte des recherches précédentes.
    'La variable Lignes() va donc être réduite à chaque nouvelle recherche.


'variable permettant d'éviter le déclenchement des événements
Private Enable_Events As Boolean

'**************variables tableaux
'variable contenant les numéros de lignes correspondantes à la recherche
Private Lignes() As Variant
'variable contenant toutes les données de la feuille :
Private Mes_Donnees() As Variant
'variable représentant la feuille qui contient les données
Private MaFeuil As Worksheet

Private Sub UserForm_Initialize()
'Au lancement de l'UserForm :
    Dim Test_Stock As Boolean, Test_Rempli As Boolean
    Set MaFeuil = Worksheets("Feuil1")
    'on stocke les données de la feuille :
    Test_Stock = Stockage(MaFeuil, 3, 1)
    If Test_Stock = False Then
        MsgBox "Erreur de stockage des données en mémoire."
        Exit Sub
    End If
    'on vide la variable tableau Lignes au cas ou
    Erase Lignes
    'on remplit la combobox1 de toutes les valeurs situées en colonne A
    'recherche de toutes les valeurs dans la colonne A
    If Recherche("*", 1) = False Then
        MsgBox "Erreur données en colonne A"
    Else
        'ici toutes les valeurs ont été trouvées et
        'les lignes correspondantes, stockées dans la variable Lignes()
        'on "empêche" le déclenchement des événements
        Enable_Events = True
        'on remplit la ComboBox1 sans doublon, triée
        Test_Rempli = Rempli_Combo(ComboBox1, 1, True)
        'on "rétablit" les événements
        Enable_Events = False
        If Test_Rempli = False Then
            MsgBox "Erreur de remplissage de la Liste déroulante"
        End If
    End If
End Sub

Private Sub ComboBox1_Click()
Dim Test_Rempli As Boolean
    If ComboBox1 = "" Or Enable_Events = True Then Exit Sub
    'on vide la variable tableau Lignes à chaque recherche
    Erase Lignes
    'on remplit la combobox2 de toutes les valeurs situées en colonne C
    'tout d'abord, on recherche en colonne 1, les lignes
    'ou se trouvent la valeur de la ComboBox1
    'ces lignes seront stockées dans la variable Lignes()
    If Recherche(ComboBox1, 1) = False Then
        MsgBox "Erreur données en colonne A"
    Else
        'on remplit la combobox2 des valeurs contenues dans
        'la colonne 3 aux lignes contenues dans la variable Lignes()
        Enable_Events = True
        Test_Rempli = Rempli_Combo(ComboBox2, 3, True)
        Enable_Events = False
        If Test_Rempli = False Then
            MsgBox "Erreur de remplissage de la Liste déroulante"
        End If
    End If
End Sub

Private Sub ComboBox2_Click()
Dim Test_Rempli As Boolean
    If ComboBox2 = "" Or Enable_Events = True Then Exit Sub
    'on remplit la combobox3 de toutes les valeurs situées en colonne D
    If Recherche(ComboBox2, 3) = False Then
        MsgBox "Erreur données en colonne C"
    Else
        Enable_Events = True
        Test_Rempli = Rempli_Combo(ComboBox3, 4, True)
        Enable_Events = False
        If Test_Rempli = False Then
            MsgBox "Erreur de remplissage de la Liste déroulante"
        End If
    End If
End Sub

Private Sub ComboBox3_Click()
Dim Test_Rempli As Boolean
    If ComboBox3 = "" Or Enable_Events = True Then Exit Sub
    'on remplit la combobox4 de toutes les valeurs situées en colonne E
    If Recherche(ComboBox3, 4) = False Then
        MsgBox "Erreur données en colonne D"
    Else
        Enable_Events = True
        Test_Rempli = Rempli_Combo(ComboBox4, 5, True)
        Enable_Events = False
        If Test_Rempli = False Then
            MsgBox "Erreur de remplissage de la Liste déroulante"
        End If
    End If
End Sub

Private Function Stockage(wshDonnees As Worksheet, Optional PremLig As Long = 1, Optional PremCol As Long = 1) As Boolean
    'Stocker toutes les valeurs de la feuille dans une variable tableau
    'cette fonction va  :
        '=> prendre toutes les valeurs de la feuille,
        '=> les stocker dans la variable tableau
        '=> contrôler cette variable tableau :
            '- contient-elle réellement des valeurs?
        'Les paramètres de cette fonction :
            'wshDonnees [obligatoire] = feuille qui contient les données
            'PremLig [facultatif = 1 par défaut] = première ligne de la plage contenant les données
            'PremCol [facultatif = 1 par défaut] = première colonne de la plage contenant les données
        'Cette fonction appelle deux autres fonctions :
            'derlig_reelle => Détermination de la dernière ligne REELLE d'une plage
            'dercol_reelle => Détermination de la dernière colonne REELLE d'une plage
    Dim Dern_Lig As Long, Dern_Col As Long, NbVal As Long, maPlage As Range
    
        'valeur par défaut de la fonction :
        Stockage = False
        
        With wshDonnees
            Dern_Lig = derlig_reelle(.Cells) 'dernière ligne remplie
            Dern_Col = dercol_reelle(.Cells) 'dernière colonne remplie
            Set maPlage = .Range(.Cells(PremLig, PremCol), .Cells(Dern_Lig, Dern_Col))
        End With
        'contient-elle réellement des valeurs?
        NbVal = WorksheetFunction.CountA(maPlage)
        'pas de valeur ==> On quitte la fonction
        If NbVal = 0 Then Exit Function
        'stockage des données
        Mes_Donnees = maPlage
        'la fonction peut retourner True
        Stockage = True
End Function

Private Function Recherche(Quoi As Variant, Colonne As Long) As Boolean
    'fonction de recherche :
    'Cette fonction va alimenter un variable tableau Lignes()
    'des numéros de lignes correspondants à la recherche.
    'Elle va également tenir compte des recherches précédentes.
        Dim lngUb As Long, tmpLignes() As Variant, lngInd As Long, lngCpt As Long
        
        'valeur par défaut
        Recherche = False
        
        'vérification s'il s'agit de la première recherche
        'dans ce cas, Lignes n'est pas encore une variable tableau allouée :
        On Error Resume Next
        lngUb = UBound(Lignes, 1)
        If Err <> 0 Then
            'la variable Lignes n'est pas encore dimensionnée
            'Il faut donc que tmpLignes aient le même nombre de lignes que Mes_Donnees
            ReDim tmpLignes(UBound(Mes_Donnees, 1))
            For lngInd = LBound(tmpLignes) To UBound(tmpLignes)
                tmpLignes(lngInd) = lngInd
            Next
        Else
            'la variable Lignes est déjà dimensionnée.
            'On la transfère dans une variable temporaire
            tmpLignes = Lignes
            'on l'efface
            Erase Lignes
        End If
        'On boucle, dans la variable Mes_Donnees,
        'sur les lignes contenues dans tmpLignes
            'soit :
                '- sur toutes les lignes de Mes_Donnees (cas de la 1ère recherche)
                '- sur les seules lignes contenues dans Lignes() (cas des recherches ultérieures)
        For lngInd = LBound(tmpLignes) To UBound(tmpLignes)
            If Mes_Donnees(tmpLignes(lngInd), Colonne) Like Quoi Then
                lngCpt = lngCpt + 1
                ReDim Preserve Lignes(lngCpt)
                Lignes(lngCpt) = tmpLignes(lngInd)
            End If
        Next lngInd
        'test du résultat
        'deux choix :
            'il y a des valeurs dans Lignes() => la fonction Recherche renvoie True
            'Lignes() est vide => la fonction Recherche renvoie False
        If lngCpt > 0 Then Recherche = True
End Function

Private Function Rempli_Combo(Combo As Control, Colonne As Long, Triee As Boolean) As Boolean
'cette fonction va remplir la combobox passée en paramètre
'des données situées dans la colonne Colonne
'aux lignes situées dans la variable Lignes
    '=> sans doublon
    '=> triée ou non (variable Triee = True : trie la liste, False : ne trie pas
    Dim indTab As Long, temp(), cpt As Long
    
        Rempli_Combo = False
        If TypeName(Combo) <> "ComboBox" Then Exit Function
        For indTab = LBound(Lignes) To UBound(Lignes)
            'astuce pour ne pas ajouter de doublon
            Combo.Value = Mes_Donnees(Lignes(indTab), Colonne)
            'si la valeur saisie dans la propriété Value existe déjà dans la combobox
            'la propriété ListIndex sera supérieure à 0
            'donc, dsans le cas contraire, on ajoute cette valeur
            If Combo.ListIndex = -1 Then
                Combo.AddItem Mes_Donnees(Lignes(indTab), Colonne)
                cpt = cpt + 1
                ReDim Preserve temp(cpt)
                temp(cpt) = Mes_Donnees(Lignes(indTab), Colonne)
            End If
        Next indTab
        'cas d'aucune valeur trouvée
        If cpt = 0 Then Exit Function
        'on la trie s'il le faut
        If Triee Then Tri temp, LBound(temp), UBound(temp)
        Combo.Clear
        Combo.List = temp
        'on n'affiche rien
        Combo.ListIndex = -1
        'la fonction renvoie True
        Rempli_Combo = True
End Function

Private Function derlig_reelle(plage As Range) As Long
'Détermination de la dernière ligne REELLE d'une plage passée en paramètre
    'REELLE = même si lignes masquées
   If WorksheetFunction.CountA(plage) = 0 Then derlig_reelle = 1: Exit Function
   derlig_reelle = plage.Find("*", , , , , xlPrevious).Row
End Function
Private Function dercol_reelle(plage As Range) As Long
'Détermination de la dernière colonne REELLE d'une plage passée en paramètre
    'REELLE = même si colonnes masquées
   If WorksheetFunction.CountA(plage) = 0 Then dercol_reelle = 1: Exit Function
   dercol_reelle = plage.Find("*", , , , , xlPrevious).Column
End Function
Private Sub Tri(a, gauc, droi) ' Quick sort
'source : http://boisgontierjacques.free.fr/
    Dim ref, g, d, temp
    ref = a((gauc + droi) \ 2)
    g = gauc: d = droi
    Do
        Do While a(g) < ref: g = g + 1: Loop
        Do While ref < a(d): d = d - 1: Loop
        If g <= d Then
            temp = a(g): a(g) = a(d): a(d) = temp
            g = g + 1: d = d - 1
        End If
    Loop While g <= d
    If g < droi Then Call Tri(a, g, droi)
    If gauc < d Then Call Tri(a, gauc, d)
End Sub

Un retour de ta part serait très apprécié.

EDIT : ajout dans le code de Erase Lignes

Avant, j'arrivais jamais à finir mes phrases... mais maintenant je

fairway111 · Answer

Bonsoir,

Oui, effectivement c'est Bouben qui m'a fait part de sa recherche sur le sujet et son code même si je ne comprends que des petits bouts de son approche fonctionne bien...

J'ai ouvert ton fichier, et malgré les explications de ton exemple, je n'ai pas les compétences suffisantes pour apprécier complètement ton code.

Mais avec les compétences des uns et des autre (et surtout des tiennes puisque tu es à l'origine de mon projet), voici ce que j'ai réussi à "assembler" avec vos contributions pour un résultat qui pour moi a une bonne allure...

Lien supprimé anonymat

C'est pour mon travail.. et ma chef est plutôt contente du résultat.
Ce petit logiciel va me permettre de gagner beaucoup de temps dans mon travail..


Ton avis pourrait me permettre de savoir si c'est pro !!

Le seul petit bug que j'ai pu constater, c'est quand je clique sur le spinbutton du UserForm2 sans remplir au moins un des champs "portefeuille" et "statut" pour activer le bouton "rechercher" ça me met un msg d'erreur de débogage donnant ainsi l'accès au code Vba..(au delà de Alt F11 pour les initiés)

Encore merci pour ton implication

fairway111 · Answer

Merci pour le débug du spinButton !!
Je reste neutre alors !

Les données étaient factices.. pas de soucis..

Encore merci

Recherche en cascade dans UserForm

7 réponses

Discussions similaires

Newsletters