ComboBox liées en fonction d'une valeur

Bonjour,

J'ai récupérer un code que j’essaye d’adapter mais je n'y arrive pas !!!

A partir de la Feuille COMMANDE (bouton ADD :ouverture formulaire, je souhaiterai à partir de la ComboBox 1, la liste sans doublons des Fournisseurs saisis de la Feuille "ARTICLE" (colonne C) ou "FOURNISSEUR" (colonne B) et récupérer dans la Combobox 2 la liste des articles liés aux fournisseur choisi de la ComboBox 1 en affichant dans la ComboBox 2 les valeurs des colonnes de B à D de la feuille Article dans l'ordre suivant (Fournisseur, Nr Article, Description).

Sans le prix pas nécessaire...

Merci pour votre aide

Bonjour,

Un test fonctionnel chez moi avec les paramètres suivants pour Cbx_Article : ColumnCount = 3 / ColumnsWidths = 90 pt;40 pt;60,95 pt

Private Sub Cbx_Fournisseur_Change()
' Contact
Dim ART(), L%, I%
If Me.Cbx_Fournisseur.ListIndex = -1 Then Exit Sub
L = 0
For I = 6 To Range("B" & Rows.Count).End(xlUp).Row
    If Cells(I, 3) = Me.Cbx_Fournisseur Then
        ReDim Preserve ART(2, L)
        ART(0, L) = Cells(I, 2)
        ART(1, L) = Cells(I, 3)
        ART(2, L) = Cells(I, 4)
        L = L + 1
    End If
Next I
Cbx_Article.List = Application.Transpose(ART)
End Sub

Cdlt,

PS : Perdu pas mal de temps en essayant de charger la 2ème colonne de la combobox avant de me rendre compte que vous aviez mis la largeur à ... 0.

Bonjour,

Merci pour votre retour rapide et désolé pour la perte de temps occasionnée.

A priori je dois avoir quelque chose qui bloque, car ma combobox renvoi une erreur au changement

Bloque sur : Cbx_Article.List = Application.Transpose(ART)

Le code fourni est en plus ou a la place de l'autre ?

J'ai l'impression qu'il n'y a rien dans la boucle concernant ART :

Bonjour,

J'ai oublié qu'on ne travaillait pas à partir de la feuille ARTICLE :

Private Sub Cbx_Fournisseur_Change()
Dim ART(), L%, I%
If Me.Cbx_Fournisseur.ListIndex = -1 Then Exit Sub
L = 0
With Worksheets("ARTICLE")
    For I = 6 To .Range("B" & .Rows.Count).End(xlUp).Row
        If .Cells(I, 3) = Me.Cbx_Fournisseur Then
            ReDim Preserve ART(2, L)
            ART(0, L) = .Cells(I, 2)
            ART(1, L) = .Cells(I, 3)
            ART(2, L) = .Cells(I, 4)
            L = L + 1
        End If
    Next I
End With
Cbx_Article.List = Application.Transpose(ART)
End Sub

Par contre lorsque l'on a qu'un seul article par fournisseur j'ai un espèce de bug d'affichage. Ce cas est-il possible ?

Cdlt,

Super ça fonctionne, encore merci

Concernant le bug c'est dans l'affichage du formulaire ? et oui ça peut arriver, y 'a t'il une solution pour corriger?

Merci

Bonjour,

Une alternative en rajoutant des en tête pour avoir à minima 2 lignes : Private Sub Cbx_Fournisseur_Change()

Dim ART(), L%, I%
If Me.Cbx_Fournisseur.ListIndex = -1 Then Exit Sub
ReDim Preserve ART(2, 0)
ART(0, 0) = "ARTICLE"
ART(1, 0) = "FOURNISSEUR"
ART(2, 0) = "DESCRIPTION"
L = 1
With Worksheets("ARTICLE")
    For I = 6 To .Range("B" & .Rows.Count).End(xlUp).Row
        If .Cells(I, 3) = Me.Cbx_Fournisseur Then
            ReDim Preserve ART(2, L)
            ART(0, L) = .Cells(I, 2)
            ART(1, L) = .Cells(I, 3)
            ART(2, L) = .Cells(I, 4)
            L = L + 1
        End If
    Next I
End With
Me.Cbx_Article.List = Application.Transpose(ART)
End Sub

Cdlt,

Pour moi c'est parfait, en vous remerciant de nouveau pour votre aide.

Bon dimanche