Alimenter un combobox par une liste filtrée suivant les résultats d'autres combobox

[fgehin]

Bonjour,

Je souhaite alimenter la liste d'un combobox qui s'appelle "code_produit_1" suivant les résultats de 2 combobox "categorie_article_1" et "genre_1".
J'ai une base de données qui contient des colonnes nommées "nature_du_produit", "genre" et nom_du_produit".

Mes 3 combobox se situent dans un userform. J'initialise les combobox "categorie_article_1" et "genre_1" par 2 listes. Je récupère les valeurs sélectionnées dans des variables publiques "categoriearticle1" et "genre1".

Je voudrais maintenant filtrer ma BDD (colonne "nature_du_produit" filtrée par le critère "categoriearticle1" et colonne "genre" filtrée par le critère "genre1") et récupérer les données filtrées dans une liste qui vienne alimenter le combobox "code_produit_1".

Quelqu'un pourrait-il m'aider ?...

Merci beaucoup d'avance pour votre aide.

Faustine

 

[Dranreb]

Je pense que le bogue vient des lignes sans tissus.
Commencez par récupérer ce numéro de ligne LCou = Lignes(1) dans la Sub CL_Résultat, LCou étant une variable As Long globale.
Et prenez en une copie dans un tableau TLgn(0 To 9) As long également global : TLgn(Produit.Value) = LCou
Vous disiez :

Il est trop complexe de démultiplier, à la main…

Mais la mise à jour pourrait se faire avec un UserForm, et non à la main, non ?
Si les combinaisons de taille et de tissus et le prix étaient listés dans une ListBox avec possibilité de sélectionner une ligne pour correction dans une TextBox pour chaque élément, ou suppression. Avec possibilité Ajout nouvelle combinaison, aussi.

De fait il semblerait que le bogue disparait en ajoutant un élément vide dans cette Sub de MSujetCBx

Function SujetMotsClés(ByVal Src, Optional ByVal Séparat As String = " ")
Rem. —— Restitue un sujet de mots clés.
'  Src: Range ou tableau 2D d'une seule colonne à inventorier.
'  Séparat: Groupe de caractères à identifier comme séparateur. Facultatif: un espace assumé.
' Remarque: Certains caractères spéciaux sont remplacés par un espace avant décomposition en mots,
'  s'il ne font pas partie de Séparat.
Dim CarEspac As String, N As Long, Te(), Le As Long, Mot As String, TSpl() As String, Ls As Long, _
  Mots() As Variant, LgnOrg() As Long, Sujet, LesListes() As Variant, TLgn() As Long, YEnAPas As Boolean
CarEspac = "!""#$%&'()*+,-./:;<=>?@[\]^_`{|}~¡¦§¨«¬®¯»¿"
For N = 1 To Len(Séparat): CarEspac = Replace$(CarEspac, Mid$(Séparat, N, 1), ""): Next N
If TypeName(Src) = "Range" Then Te = Src.Value Else Te = Src
For Le = 1 To UBound(Te)
  Mot = Te(Le, 1): For N = 1 To Len(Mot)
  If InStr(CarEspac, Mid$(Mot, N, 1)) > 0 Then Mid$(Mot, N, 1) = " "
  Next N
  TSpl = Split(Mot, Séparat): YEnAPas = True
  For N = 0 To UBound(TSpl): Mot = Trim$(TSpl(N))
  If Mot <> "" Then
  Mid$(Mot, 1, 1) = UCase$(Mid$(Mot, 1, 1)): Ls = Ls + 1: ReDim Preserve Mots(1 To Ls), LgnOrg(1 To Ls)
  Mots(Ls) = Mot: LgnOrg(Ls) = Le: YEnAPas = False: End If
  Next N
  If YEnAPas Then
  Ls = Ls + 1: ReDim Preserve Mots(1 To Ls), LgnOrg(1 To Ls)
  Mots(Ls) = Empty: LgnOrg(Ls) = Le: End If
  Next Le
Sujet = SujetCBx(WorksheetFunction.Transpose(Mots))
LesListes = Sujet(1)
For N = LBound(LesListes) To UBound(LesListes)
  TLgn = LesListes(N)
  For Ls = LBound(TLgn) To UBound(TLgn): TLgn(Ls) = LgnOrg(TLgn(Ls)): Next Ls
  LesListes(N) = TLgn
  Next N
SujetMotsClés = Array(Sujet(0), LesListes)
End Function

Modifs: Ajout d'un YEnAPas As Boolean, positionné à True au début de chaque Le, mis à false dès qu'au moins un mot valide est noté, à la fin, s'il est resté à True ajout quand même d'un élément vide.

 

[fgehin]

Merci beaucoup, le bug a effectivement été réglé !

J'essaie maintenant de récupérer le prix correspondant à la catégorie de prix du tissu sélectionnée, que je voudrais afficher dans le label prix_unitaire.

J'ai donc écrit le code suivant mais ma tentative de récupération de la ligne active de la BDD semble ne pas fonctionner (j'ai utilisé la fonction PlgUti) .Une erreur de syntaxe je suppose ?...

Private Sub tissu_Change()

Dim i As Integer

tissu_contenu = tissu.Value

Select Case tissu_contenu
Case Not CL.PlgTablo.Columns(31).Find(What:=tissu_contenu) Is Nothing
i = 32
Case Not CL.PlgTablo.Columns(33).Find(What:=tissu_contenu) Is Nothing
i = 34
Case Not CL.PlgTablo.Columns(35).Find(What:=tissu_contenu) Is Nothing
i = 36
Case Not CL.PlgTablo.Columns(37).Find(What:=tissu_contenu) Is Nothing
i = 38
Case Not CL.PlgTablo.Columns(39).Find(What:=tissu_contenu) Is Nothing
i = 40
Case Not CL.PlgTablo.Columns(41).Find(What:=tissu_contenu) Is Nothing
i = 42
End Select

prix_unitaire_contenu = PlgUti(CL.PlgTablo.Columns(i))
prix_unitaire = prix_unitaire_contenu

End Sub

 

[Dranreb]

Bonjour.
Il n'y plus aucun Find à faire: l'objet CL a déjà tout fait.
D'habitude je déclare aussi un tableau VLgn() As Variant global et je fais
VLgn = CL.PlgTablo.Rows(LCou).Resize(, x).Value avec x le nombre de colonnes à récupérer.
Je garnis ensuite mes contrôles à partir des éléments VLgn(1, i) généralement dans une procédure que j'appelle GarnirChamps car j'ai souvent besoin de le faire depuis plusieurs endroits.
Rappel: LCou, global, doit contenir le numéro de ligne communiqué dans Lignes(1) à la procédure CL_Résultat.
(de préférence seulement si Ubound(Lignes) = 1, parce que sinon ça signifie que les choix effectués dans les ComboBox sont insuffisants pour isoler une seule ligne)
Il y a un truc que vous n'avez pas l'air d'avoir compris: bien qu'au CL.Plage on n'a spécifié que sa 1ère ligne, CL.PlgTablo représente l'ensemble de la base.

 

[fgehin]

Merci de votre réponse, mais du coup je ne suis plus très sûre de comprendre. Votre solution très "propre" me semble fonctionner lorsque j'ai une information unique par cellule (ce qui, je le sais bien, correspond à votre recommandation depuis le début - mais qui n'est pas mon cas sur ce cas de figure).

Bref, j'ai tenté de suivre vos recommandations mais bute de toute façon sur une erreur 1004 de compilation.

Je soumets mon fichier à votre sagacité j'imagine que ça vous sera beaucoup plus évident qu'à moi...

Merci encore pour tout.

Bien cordialement,

Faustine

 

[Dranreb]

Pourquoi ne mettez vous pas dans la base uniquement les articles que vous avez effectivement en stock ?
Vous n'en avez quand même pas des centaines de millions combinant toutes les tailles et tissus possibles, si ?

Vous avez mis au mauvais endroit l'affectation de VLgn, et vous n'avez pas remplacé x par le nombre de colonnes.
Faites comme ça:

Private Sub CL_Change(ByVal Complet As Boolean, ByVal NbrLgn As Long)
If NbrLgn = 1 Then Exit Sub
LCou = 0
TLgn(Produit.Value) = 0
ReDim VLgn(1 To 1, 1 To 51)
GarnirChamps ' pour les vider ici en fait
End Sub

Private Sub CL_Résultat(Lignes() As Long)
If UBound(Lignes) > 1 Then Exit Sub
LCou = Lignes(1)
TLgn(Produit.Value) = LCou
VLgn = CL.PlgTablo.Rows(LCou).Resize(, 51)
GarnirChamps
End Sub

Private Sub GarnirChamps()
Rem. Garnissez vos contrôles ici, à partir des VLgn(1, x) ' pas x à chaque fois bien sûr ! Le n° de la colonne concernée !!
End Sub

Mettez ces procédure plus haut, parce qu'elles sont fondamentales, juste après la UserForm_Initialize, qui devrait être la première à mon avis.

Supprimez les procédures tissus_Change et Taille_Change si vous tenez à ce que ces ComboBox soient prises en charge par CL, c'est à dire si le choix d'un tissus doit limiter les choix proposés, dans les autres ComboBox non encore renseignés, aux articles qui contiennent ce tissu.

 

[fgehin]

En fait l'entreprise fabrique à la demande, sur mesure, et de façon personnalisée, donc oui effectivement les combinaisons sont quasi-infinies (enfin, pas du point de vue mathématique, mais du point de vue humain, oui). Il n'y a donc pas de problématique de stock.

J'ai intégré les différentes procédures ci-dessus et j'ai un bug à la compilation au sujet de TLgn(), qui n'est pas définie...

 

[Dranreb]

Définissez le comme je l'ai indiqué au poste #10: TLgn(0 To 9) As Long, ainsi que tous les tableaux de renseignements divers dont vous aurez besoin, de 10 postes numéroté de 0 à 9 comme les valeurs possible de la propriét Value du TabStrip produit.
Ah c'est de la confection !!! Ce sont un peu des recettes potentielles possibles en quelque sorte.
Je n'avais pas du tout compris ça…
Dans ce cas je pense que le travail de CL doit se limiter aux ComboBox reflétant des données jusqu'à la colonne F, pas plus loin.
Et que les ComboBox des caractéristiques à la demande doivent être initialisées dans GarnirChamps.
Mais je ne comprends pas comment ça marche tout ça. Notamment comment le tissus et la taille se combinent pour donner le prix… Il n'y a pas de formules pour le calculer (pas au sens Excel j'entends) ?

Mais alors… S'il n'y a pas de stock, à quoi rime les tailles disponibles ? Et s'il faut plutôt les voir comme des tailles techniquement possibles, pourquoi y a-t-il des 2 dans certaines colonnes ?

 

[fgehin]

oui vous avez bien compris... c'est compliqué. En fait les tailles et les tissus impactent le prix par catégorie. C'est à dire que les tissus a, b, c, d de la catégorie "tissus 1" induiront un "prix 1" (idem pour les autres catégories). Les tailles 1 quant à elles seront au prix de base (donc celui du tissu 1), les tailles 2 induiront un delta de +12% dans le prix, etc...

Je n'ai pas indiqué toutes les variables de calcul dans la BDD puisque certains valeurs sont rentrées en dur et utilisées dans le calcul final du prix (d'où la nécessité d'automatiser cette procédure fastidieuse qui jusqu'ici était réalisée à la main...).

La BDD est par ailleurs en cours de remplissage, je me projette donc dans l'exploitation de sa version finale au travers de cet outil.

Ceci étant dit, je rencontre plusieurs bugs (suivant les options choisies) :

• un run-time error '13' Type mismatch dans CL_Résultat
• un run-time error '9' Subscript out of range dans tissu_change()

 

[Dranreb]

Je ne voit aucun des changements que j'ai indiqués au poste #20
Ça a l'air d'une version plus ancienne.
À mon avis tissus et tailles ne doivent plus être gérés par CL

 

[fgehin]

ah oui pardon je me suis trompée de version !

 

[Dranreb]

Pas réussi à reproduire l'erreur dans CL_Résultat.
Il ne faut pas contrarier CL par des _Change pour des ComboBox prises en charge par lui.
À mon avis tissu, taille et les optionx ne doivent plus être confiés à CL. Il faut tout faire dans GarnirChamps.
Un changement d'une ComboBox prise en charge par un objet ComboBoxLiées débouche toujours sur l'évènement Change de l'objet et sur son évèment Résultat s'il y a au moins une ligne correspondant aux choix.

 

[fgehin]

Alors j'ai supprimé tissu, taille et les options de CL mais je rencontre toujours la même run-time error '13' Type mismatch dans CL_Résultat. Pour la reproduire, il suffit de choisir n'importe quel produit dans le combobox "code_produit".

J'ai par ailleurs tenté d'utiliser GarnirChamps() pour tissu, mais je ne suis pas sûre de la syntaxe (et je ne peux la tester à cause du bug ci-dessus). Par ailleurs, étant donné que les cellules de tissus comprennent plusieurs tissus dans une même cellule, et qu'ils étaient initialement reconnus et pris en charge par SujetMotsClés() qui est lié à CL, je suppose que je ne peux plus l'utiliser en l'état ? Comment faire, en utilisant garnir champs, pour que les différentes lignes de ma cellule soient reconnues comme des items séparés ?

Merci infiniment d'avance.

Bien cordialement,

Faustine

 

[Dranreb]

Bonjour.
Ajoutez .Value derrière.
VLgn = CL.PlgTablo.Rows(LCou).Resize(, 51).Value
C'est ce que j'avais indiqué et que je fais toujours …même si je ne comprends pas trop pourquoi il ne l'assume pas ici.
Ne pourriez vous éviter les blancs soulignés dans les noms, afin d'éviter toute confusion avec son utilisation en tant que séparateur entre l'objet et l'évènement dans les noms de procédures évènements. Collez plutôt tout mais en mettant une majuscule au début chaque mot. Et surtout un préfixe de 3 lettres devant reprenant les majuscules et la dernière lettre du nom de type de l'objet. Sinon, avec les développements qui s'annoncent (GarnirChamps risque de devenir à la longue une procédure énorme) on ne va jamais s'en sortir. Et des noms courts. Au lieu de catégorie_article ça donnerait par exemple CBxCatArt.

Rien que pour préparer la liste des tissus, ça donnerait :

Private Sub GarnirChamps()
Dim TNomTiss(), N&, C&, TSpl$(), S&
ReDim TNomTiss(0 To 100), TPrixTiss(0 To 100) ' TPrixTiss() As Currency: global
N = -1
For C = 31 To 41 Step 2
  TSpl = Split(VLgn(1, C), vbLf)
  For S = 0 To UBound(TSpl)
     N = N + 1: TNomTiss(N) = TSpl(S): TPrixTiss(N) = VLgn(1, C + 1)
     Next S, C
If N >= 0 Then ReDim Preserve TNomTiss(0 To N): CBxTissu.List = TNomTiss Else CBxTissu.Clear

End Sub

Et on peut se débarrasser de la colonne 43.

Suggestion: pour les options, prévoir une ListBox à 3 colonnes et à sélections multiples.

 

[fgehin]

Bonjour Dranreb, et merci encore de votre réponse.

Alors ça fonctionne comme ça, mais les tissus ne s'affichent pas pour tous les produits. Par exemple, quelques tests pris au hasard : les tissus s'affichent pour ACANTHE, mais pas pour ABBEL ou ABELO. J'imagine qu'il y a un format de données qui est bloquant dans la BDD pour ces cas de figure, sauriez-vous duquel il s'agit ?

Merci beaucoup d'avance.

Bien cordialement,

Faustine

 

[Dranreb]

Ils ne s'affichent que lorsque les choix aboutissent à une seule ligne.
En particulier pour ABELO quand vous avez décidé Genre "F" ou "(vide)"
Ici une version qui supporte aussi bien les espaces que les vbLf, et assume le classement des noms de tissus :

Private Sub GarnirChamps()
Dim TNmTBrut(0 To 100), TPxTBrut(0 To 100) As Currency, NomTiss$, TNomTiss(), N&, C&, TSpl$(), S&
N = -1
For C = 31 To 41 Step 2
  TSpl = Split(Replace(VLgn(1, C), vbLf, " "))
  For S = 0 To UBound(TSpl)
  NomTiss = Trim$(TSpl(S)): If NomTiss <> "" Then N = N + 1: _
  TNmTBrut(N) = NomTiss: TPxTBrut(N) = VLgn(1, C + 1)
  Next S, C
If N >= 0 Then
ReDim TNomTiss(0 To N), TPrixTiss(0 To N): S = -1 ' TPrixTiss() As Currency: global
With New TableIndex
  .Init 0, N: While .Actif: .BInfA = TNmTBrut(.B) < TNmTBrut(.A): Wend
  .Parcourir: While .Actif: S = S + 1: N = .Suivant: _
  TNomTiss(S) = TNmTBrut(N): TPrixTiss(S) = TPxTBrut(N): Wend: End With
  CBxTissu.List = TNomTiss
Else: CBxTissu.Clear: End If
   
End Sub