Combobox en cascade (filtrages successifs par 2 combobox)

Télécharger le projet
Commenter

Description

Il n'est pas aisé de récupérer le résultat d'un filtrage d'Excel dans une ComboBox.
La source permet d'aborder une voie de contournement de ce problème en passant par des ComboBox en cascade.
Pour offrir une piste de rélexion, on se limitera à un exemple simple : Une application sauvegarde des fichiers archive selon des chemins différents, que l'on veut pouvoir réimporter dans l'application en sélectionnant un des chemins, puis un des fichiers présents.

Source / Exemple : 


'Dans la feuille "Liste"
'=======================

Private Sub ButtonExtraire_Click()

Application.ScreenUpdating = False      'Désactive la mise à jour de l'affichage

Classer.ClasserLesChemins               'Mise en forme de la liste
ExtraireFichier.Show                    'Appel de la UserForm

Application.ScreenUpdating = True       'Réactive la mise à jour de l'affichage

End Sub

'---------------------------------------------------------------------------

'Dans la UserForm "ExtraireFichier"
'==================================

Private Sub UserForm_Initialize()
'Initialisation de la liste des Chemins sans doublons

Application.ScreenUpdating = False                                                  'Désactive la mise à jour de l'affichage

'Déclarations
Dim i As Integer

'Run
For i = 2 To Sheets("Liste").Range("A65536").End(xlUp).Row                          'Boucle sur chaque valeur non nulle en colonne A depuis A2
  CheminTxt = Sheets("Liste").Range("A" & i)                                        'Reprise de chaque valeur en colonne A depuis A2
  If CheminTxt.ListIndex = -1 Then CheminTxt.AddItem Sheets("Liste").Range("A" & i) 'Ajoute à la liste si différent du précédent
Next i                                                                              'pas suivant
CheminTxt = ""                                                                      'Efface le dernier Chemin trouvé et donc affiché

Application.ScreenUpdating = True                                                   'Réactive la mise à jour de l'affichage

End Sub

Private Sub ButtonOK_Click()
'Excécuter selon les choix validés

Application.ScreenUpdating = False                                                  'Désactive la mise à jour de l'affichage

'Déclarations
Dim CheminFichier
Dim NomFichier

'Run
If ExtraireFichier.CheminTxt.Text = "" _
Or ExtraireFichier.NomTxt.Text = "" Then
    Exit Sub                                                                        'si aucun Chemin ou Nom, on quitte la sub
Else
    CheminFichier = ExtraireFichier.CheminTxt.Text                                  'Reprise saisie Chemin
    NomFichier = ExtraireFichier.NomTxt.Text                                        'Reprise saisie Nom
    
    'Vérifie l'existence d'un fichier du même nom et propose une action ...
    FichierExistant = Dir(CheminFichier & NomFichier & ".xls", vbDirectory)
    
    'si Existe pas :
    If FichierExistant = "" Or FichierExistant = "." Then
        MsgBox _
        "le fichier : " & CheminFichier & NomFichier & " n'existe pas...", _
        vbCritical, "Importer le Fichier " & CheminFichier & NomFichier
        Exit Sub
    
    'si Existe
    Else
        ImportFichier.Hide                                                          'masque la form
        
        'Appeller votre application d'importation du fichier à extraire
        'ImporterFichier                                                            'Appelle la sub ImporterFichier
    
    End If
End If

Application.ScreenUpdating = True                                                   'Réactive la mise à jour de l'affichage

End Sub

Private Sub CheminTxt_Change()
'Construit la liste des Noms de Fichiers Archive accessibles par le Chemin sélectionné

Application.ScreenUpdating = False                                                  'Désactive la mise à jour de l'affichage

'Déclarations
Dim i As Integer

Me.NomTxt.Clear                                                                     'Vide la ComboBox CheminTxt
With Sheets("Liste")                                                                'Dans la feuille "Liste"
    For i = 2 To .Range("A65536").End(xlUp).Row                                     'Dans la liste de Chemins de la colonne A
        If .Range("A" & i) = CheminTxt.Value Then Me.NomTxt.AddItem .Range("B" & i) 'Ajoute à la liste si Le Nom est en relation avec le Chemin
    Next
End With

Application.ScreenUpdating = True                                                   'Réactive la mise à jour de l'affichage

End Sub

'---------------------------------------------------------------------------

'Dans le Module "Classer"
'========================

Sub ClasserLesChemins()

Application.ScreenUpdating = False                          'Désactive la mise à jour de l'affichage

Sheets("Liste").Select                                      'Dans la feuille "Liste"
l = Range("A65536").End(xlUp).Row                           'Dernière ligne non nulle de "Liste"

'Classement alphabétique Chemins, puis Noms
Range("A2:B" & l).Sort _
    Key1:=Range("A2"), _
    Order1:=xlAscending, _
    Key2:=Range("B2"), _
    Order2:=xlAscending, _
    Header:=xlNo, _
    OrderCustom:=1, _
    MatchCase:=False, _
    Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal, _
    DataOption2:=xlSortNormal

Application.ScreenUpdating = True                           'Réactive la mise à jour de l'affichage

End Sub

'---------------------------------------------------------------------------

Conclusion :


L'application crée la liste des chemins + fichiers dans une feuille "Liste" :
Les noms des Chemins complets en colonne A
Les noms des Fichiers Archive en colonne B

Un bouton "Extraire" permet de classer la liste (sub "ClasserLesChemins") et d'afficher 2 ComboBox de la UserForm "ExtraireFichier":
> L'une pour choisir un des chemins existants (sans doublon) : "CheminTxt"
> L'autre pour choisir le nom d'un fichier à récupérer par l'application selon le Chemin sélectionné : "NomTxt"

Bien sûr, si la "Liste" est exploitée depuis un autre Classeur, il faudra peut-être configurer ShowModal=False dans la UserForm...

Merci pour vos commentaires.
Cordialement.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (CerberusPau)