Microsoft 365 ComboBox en cascade

  • Initiateur de la discussion Initiateur de la discussion juju91
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

juju91

XLDnaute Junior
Bonjour,

J'aurais encore besoin de votre aide.
Est il possible de mettre en cascade deux ComboBox comme pour les listes déroulantes.
Dans une feuille j'ai un ComboBOX qui est alimenté par une liste .
Chaque élément de la liste correspond à des listes de produits.
Comme précédemment indiqué, je souhaiterais, avec le premier comboBOX sélectionner le type d'article afin d'avoir accès, dans le deuxième comboBOX à la liste des a articles correspondant (le choix de l'article dans le 2e comboBox déclenche une macro qui va enregistrer le résultat sur la dernière ligne d'une plage donnée).


Je ne suis pas sûr d'avoir été très clair, je mets donc un fichier exemple ci-joint.


Par avance merci aux personnes qui pourront m'aider

Cdt
 

Pièces jointes

Solution
Bonsoir à toutes & à tous, bonsoir @juju91
je ne peux toujours ajouter que deux produits pas plus.
Chez moi :
1746567973354.gif

(J'ai modifié le style du TS pour qu'on le vois clairement. Je ne sais pas si tu avais vu mais j'ai créé un style de TS "Tout bleu" que tu peux utiliser si tu préfères ta mise en forme initiale.)


Bon vérifie cette option qui fait que les TS s'étendent automatiquement ou non :
1746564100391.png


Mais j'ai modifié mon code pour prendre en charge l'extension du tableau :
VB:
Private Sub CBx_ChoixFamilles_Change()
     CBx_ChoixProduits.ListFillRange = "n_ListeProduits"
     CBx_ChoixProduits.ListIndex = -1
End Sub

Private Sub CBx_ChoixProduits_Change()
    
     If Auto Or CBx_ChoixProduits.ListIndex = -1...
Bonne nuit à toutes & à tous
@cathodique , j'ai dit :

C'est malin quand on est privé pendant toute un semaine de ces fonctionnalités !😉

J'ai relu le code que j'ai posté sur le fil et je ne comprends pas :

En effet à chaque nouvelle sélection j'ajoute cette sélection à la fin du TS "TS_OFFRE" :
Regarde la pièce jointe 1217302
Y a kéqu' chose qui cloche la d'dans j'y retourne immédiatement (non ce soir quand je serai rentré !)

À +
Re, fais un tour dans les propriétés des comboboxs pour comprendre le pourquoi de la chose.
Même moi, je suis tombé dans le piège. Mon était correct, mais le résultat n'était pas au RDV.
Les combos sont liées à une cellule.
 
Bonsoir à tous,
Tout d'abord comme énoncé par @vgendron le tableau de data est à revoir dans son intégralité.
Ensuite puisque vous travailler sous Office 365 pourquoi ne pas utiliser ses fonctions puissantes .
Je sais que je radote mais il vaut toujours mieux initialiser un tableau dans un Pattern Factory. Cela évite de se peler tout le code si changement. Donc dans un module nommé Factory on colle la fonction d'initialisation du tableau :
VB:
'@Description "Initialise le tableau des données de base."
Public Function InitTabData( _
       Optional ByVal Reset As Boolean _
       ) As ListObject
   
    Static Item As ListObject
    If Item Is Nothing Or Reset Then
        Set Item = GetListObject("vt_Data")
    End If
    Set InitTabData = Item
End Function
On peut faire de même pour les noms de colonnes toujours dans le module Factory :


VB:
Public Type DataColumns
    ID As String
    Names As String
    Prices As String
    Types As String
    Suppliers As String
    Notes As String
    'Add more
End Type

'@Description "Retourne les noms de colonnes pour le tableau Data."
Public Function GetDataColumnNames( _
       ) As DataColumns

    Dim Columns As DataColumns
    With Columns
        .ID = "ID"
        .Names = "Désignations"
        .Prices = "PA/U"
        .Types = "Types"
        .Suppliers = "Fourniseurs"
        .Notes = "Notes"
        'Add more
    End With
    GetDataColumnNames = Columns
End Function
On peut maintenant utiliser tout ce petit monde sans écrire en dur leurs noms, dans l'exemple ci-dessous nous récupérons un ligne du tableau d'après son index qui est retourné par la zone de liste ProductsList.
VB:
    ' // Recherche de la ligne sélectionnée dans la zone de liste ProductList
    Dim lstRowSource As Excel.ListRow
    Set lstRowSource = Current.GetRow(Factory.InitTabData, sourceColumns.ID, ProductsList.Value)
Maintenant pourquoi ne pas utiliser les fonctions propres à Excel ?
Dans l'exemple ci-dessous, nous avons un premier filtre qui filtre la colonne Types du tableau vt_Data selon le critère de la liste déroulante FamilyList. Le second filtre ne renvoie que la première et deuxième colonne.
VB:
'@Description "Click sur la liste déroulante Famille de produits."
Private Sub FamilyList_Click()
    Dim Formula As String
    'Formula = "=SORT(FILTER(FILTER(vt_Data,(vt_Data[Types]=sysvr_Familles)),{1,1,0,0,0,0,0,0,0,0,0,0,0,0,0}))"
    Formula = "=SORT(FILTER(FILTER({table},({table}[{column}]={search})),{1,1,0,0,0,0,0,0,0,0,0,0,0,0,0}))"
    Formula = Replace(Formula, "{table}", Factory.InitTabData.Name, 1, -1, vbTextCompare)
    Formula = Replace(Formula, "{column}", Factory.GetDataColumnNames.Types, 1, -1, vbTextCompare)
    Formula = Replace(Formula, "{search}", "sysvr_Familles", 1, -1, vbTextCompare)
   
    ' // Met à jour la liste déroulante ProductsList en fonction de la famille de produits sélectionnée dans FamilyList.
    With ProductsList
        .Clear
        .List = GetListWithEvaluate(Formula)
    End With
End Sub
La fonction GetListWithEvaluate nous assure d'avoir toujours un tableau (Array) à deux dimensions même si le filtre renvoie qu'une seule ligne.
VB:
'@Description "Récupère un tableau de valeurs avec la fonction Evaluate."
Private Function GetListWithEvaluate(ByVal Value As String)
    Dim Result As Variant
    Result = Evaluate(Value)
   
    ' // La fonction Evaluate renvoie une erreur !
    If IsError(Result) Then
        Dim ErrorType As String
        If Application.WorksheetFunction.IsNA(Result) Then
            ErrorType = "#N/A"
        ElseIf Application.WorksheetFunction.IsErr(Result) Then
            ErrorType = "#ERR"
        ElseIf Application.WorksheetFunction.IsValue(Result) Then
            ErrorType = "#VALUE!"
        ElseIf Application.WorksheetFunction.IsRef(Result) Then
            ErrorType = "#REF!"
        ElseIf Application.WorksheetFunction.IsDiv0(Result) Then
            ErrorType = "#DIV/0!"
        ElseIf Application.WorksheetFunction.IsNum(Result) Then
            ErrorType = "#NUM!"
        Else
            ErrorType = "Erreur Inconnue"
        End If
       
        ReDim tabResult(1 To 1, 1 To 2) As Variant
        tabResult(1, 1) = 0                      ' Index en dehors des limites de recherche d'index
        tabResult(1, 2) = "La fonction renvoie l'erreur : " & ErrorType
        GetListWithEvaluate = tabResult
   
        ' // Une seule ligne est trouvée le tableau est à une dimmension
    ElseIf Current.NumberOfArrayDimensions(Result) = 1 Then
        ReDim tabResult(1 To 1, 1 To 2) As Variant
        tabResult(1, 1) = Result(1)
        tabResult(1, 2) = Result(2)
        GetListWithEvaluate = tabResult
   
        ' // Un tableu est renvoyé
    Else
        GetListWithEvaluate = Result
       
    End If
End Function
Et pour finir un clic dans la zone de liste ProductsList met à jour le tableau des produits sélectionnés.
VB:
'@Description "Click sur la liste déroulante de sélection de produits."
Private Sub ProductsList_Click()
    ' // Affectation des noms de colonnes du tableau Data.
    Dim sourceColumns As Factory.DataColumns
    sourceColumns = Factory.GetDataColumnNames
   
    ' // Affectation des noms de colonnes du Tableau des produits sélectionnés.
    Dim cibleColumns As Factory.SelectedColumns
    cibleColumns = Factory.GetSelectedProductsColumnNames
   
    ' // Recherche de la ligne sélectionnée dans la zone de liste ProductList
    Dim lstRowSource As Excel.ListRow
    Set lstRowSource = Current.GetRow(Factory.InitTabData, sourceColumns.ID, ProductsList.Value)
   
    ' // Ajout d'une ligne sur le tableau des produits sélectionnés.
    Dim lstRowCible As Excel.ListRow
    Set lstRowCible = Factory.InitTabSelectedProducts.ListRows.Add
    With lstRowCible
        If Not lstRowSource Is Nothing Then
            ' // On rempli la ligne
            .Range(.Parent.ListColumns(cibleColumns.Types).Index).Value = lstRowSource.Range(lstRowSource.Parent.ListColumns(sourceColumns.Types).Index).Value
            .Range(.Parent.ListColumns(cibleColumns.Names).Index).Value = lstRowSource.Range(lstRowSource.Parent.ListColumns(sourceColumns.Names).Index).Value
            .Range(.Parent.ListColumns(cibleColumns.Prices).Index).Value = lstRowSource.Range(lstRowSource.Parent.ListColumns(sourceColumns.Prices).Index).Value
        End If
    End With
End Sub

Voilà bonne programmation.
 

Pièces jointes

Bonjour à toutes et à tous, bonjour @juju91
Bon, j'ai retrouvé mon matériel !
Tu sembles avoir opté pour la solution bien plus structurée de @cathodique et tu as bien raison !
Mais comme je t'ai dis que je le ferais, j'ai fait évoluer ma version basée sur ta feuille "BD PROD" initiale (suite de tableaux non structurés se suivant horizontalement)
Comme précédemment les résultats vont dans un tableau structuré "TS_OFFRE" de la feuille "OFFRE" que tu peux placer où tu veux (je l'ai mis en G1:H2 pour l'exemple)
1746434952407.gif

J'ai mis ta colonne "CD portion" à côté de la colonne "Produit" comme tu semblais le vouloir.
La formule pour générer la liste des familles de produits
VB:
=LET(Sce;TRANSPOSE(n_Source);Crit;CHOISIRCOLS(Sce;1)="x";TRIER(CHOISIRCOLS(FILTRE(Sce;Crit);2)))
La formule pour générer la liste des produits
VB:
=LET(Sce;TRANSPOSE(n_Source);
          Col;TRANSPOSE(COLONNE(n_Source));
          Crit;INDEX(Sce;;1)="x";
          LstSce;INDEX(FILTRE(Sce;Crit);;2);
          LstCol;FILTRE(Col;Crit);
          Idx;RECHERCHEX(n_FamilleChoisie;LstSce;LstCol;"");
          Adrs;INDIRECT(ADRESSE(6;Idx;1;1;"BD PROD")&":"&ADRESSE(1048576;Idx;1;1));
          nb;NBVAL(Adrs);
          lst_1;DECALER(Adrs;0;0;nb;1);
          lst_2;DECALER(Adrs;0;11;nb;1);
SIERREUR(ASSEMB.H(SI(lst_1="";{""};lst_1);SI(lst_2=0;{""};lst_2));{"".""})
)
Les noms définis

Noms définisDéfinitionsCommentaires
TS_OFFRE=OFFRE'!$G$2:$H$...Tableau structuré reccueillant les offres choisies
n_Source='BD PROD'!$A$1:$DD$2Lignes pour identifier les familles de produits
n_FamillesProduits=TABLES!$A$3#Familles de produits (ListFillRange de la ComboBox "CBx_ChoixFamilles"
n_FamilleChoisie=OFFRE!$A$4Famille de produits choisie (LinkedCell de la ComboBox "CBx_ChoixFamilles")
n_ListeProduits=TABLES!$C$3#Liste des produits (ListFillRange de la ComboBox "CBx_ChoixProduits"
n_ProduitChoisi='OFFRE '!$A$5Produit choisi (LinkedCell de la ComboBox "CBx_ChoixProduits")





Le code des macro n'a quasiment pas changé :
Le code de la feuille "OFFRE"
VB:
Dim Auto As Boolean

     Private Sub CBx_ChoixFamilles_Change()
          CBx_ChoixProduits.ListFillRange = "n_ListeProduits"
          CBx_ChoixProduits.ListIndex = -1
     End Sub

Private Sub CBx_ChoixProduits_Change()

     If Auto Or CBx_ChoixProduits.ListIndex = -1 Then Exit Sub
     Application.ScreenUpdating = False
     Auto = True
        
          idx = CBx_ChoixProduits.ListIndex + 1  'Index du produit choisi dans la liste des produits
        
          [F4].Select 'Retirer le focus de la ComboBox
          [n_ProduitChoisi].ClearContents
          CBx_ChoixProduits.ListIndex = -1
        
          Produits = [n_ListeProduits].Value2  'Liste des des produits de la famille sélectionnée (avec une 2ème colonne numérique)
        
          MoinsUn = IsEmpty([TS_OFFRE[Produits]].Rows(1).Value2) '(vaut -1 si vrai : TS vide)
        
          'Stocker dans le TS
          Set Cible = [TS_OFFRE[Produits]].Rows([TS_OFFRE].Rows.Count + MoinsUn + 1)
          Cible.Value2 = Produits(idx, 1)
          Cible.Offset(0, 1).Value2 = Produits(idx, 2) '(si besoin de la colonne adjacente)
        
     Auto = False
End Sub

La macro de remise à zéro :
VB:
Sub RàZ_Offres()
     With [TS_OFFRE]
          .ClearContents
          .ListObject.Resize .Offset(-1).Resize(2)
     End With
End Sub
Voilà, voir le fichier joint
À bientôt
 

Pièces jointes

Bonjour AtTheOne,
Je vous remercie pour votre retour, pour répondre a votre question, j'étudies toutes les propositions qui me sont faites.
Surtout, j'essaye de prendre la plus simple et celle que je comprends le mieux, malgré mon petit niveau en VBA.
J'évite d'utiliser des ''choses'' que je ne comprends.

Par contre, désolé, j'ai encore le même problème.

je ne peux toujours ajouter que deux produits pas plus.
Dés que je sélectionne un troisième produits, il vient se positionner toujours sur la première ligne après le tableaux TS_OFFRE.
Est ce qu'il y a un paramétrage spécial a faire sur Excel sachant que je suis en version 365

Encore un très grand merci pour votre patience.


Cdt
 
Bonsoir à toutes & à tous, bonsoir @juju91
je ne peux toujours ajouter que deux produits pas plus.
Chez moi :
1746567973354.gif

(J'ai modifié le style du TS pour qu'on le vois clairement. Je ne sais pas si tu avais vu mais j'ai créé un style de TS "Tout bleu" que tu peux utiliser si tu préfères ta mise en forme initiale.)


Bon vérifie cette option qui fait que les TS s'étendent automatiquement ou non :
1746564100391.png


Mais j'ai modifié mon code pour prendre en charge l'extension du tableau :
VB:
Private Sub CBx_ChoixFamilles_Change()
     CBx_ChoixProduits.ListFillRange = "n_ListeProduits"
     CBx_ChoixProduits.ListIndex = -1
End Sub

Private Sub CBx_ChoixProduits_Change()
    
     If Auto Or CBx_ChoixProduits.ListIndex = -1 Then Exit Sub
     Application.ScreenUpdating = False
     Auto = True

          idx = CBx_ChoixProduits.ListIndex + 1  'Index du produit choisi dans la liste des produits
          MoinsUn = IsEmpty([TS_OFFRE[Produits]].Rows(1).Value2) '(si vrai dans un calcul vaut -1 : le TS est vide, on écrit sur cette ligne vide)
         
          [TS_OFFRE].Cells([TS_OFFRE].Rows.Count + 1 + MoinsUn, 1).Select 'Retirer le focus de la ComboBox
          [n_ProduitChoisi].ClearContents
          CBx_ChoixProduits.ListIndex = -1

          Produits = [n_ListeProduits].Value2  'Liste des des produits de la famille sélectionnée (avec une 2ème colonne numérique)
         
          'Stocker dans le TS
          'Redimensionner le TS
          [TS_OFFRE].ListObject.Resize [TS_OFFRE].Offset(-1).Resize([TS_OFFRE].Rows.Count + 2 + MoinsUn)

          'Définir la cellule cible
          Set Cible = [TS_OFFRE].Rows([TS_OFFRE].Rows.Count)
          Cible.Cells(1, 1).Value2 = Produits(idx, 1)
          Cible.Cells(1, 2).Value2 = Produits(idx, 2) '(si besoin de la colonne adjacente)

     Auto = False

End Sub

et ausi légèrement le code du RàZ :
VB:
Public Auto As Boolean

Sub RàZ_Offres()
     Auto = True
     With [TS_OFFRE]
          .ClearContents
          .Offset(1).Resize(23).ClearFormats
          .ListObject.Resize .Offset(-1).Resize(2)
          Application.Goto .Cells(1, 1)
     End With
     Auto = False
End Sub

Voilà essaie mon fichier sans préalablement y apporter de modifications et tiens moi informé.

(Je ne sais pas si tu avais vu mais j'ai créé un style de TS "Tout bleu" que tu peux utiliser si tu préfères ta mise en forme initiale.)

À bientôt
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
1
Affichages
935
Réponses
3
Affichages
1 K
Réponses
19
Affichages
2 K
Réponses
1
Affichages
880
Réponses
1
Affichages
620
Retour