Titre du sujet : Re: Problème BDD et Liste cascade
par myDearFriend! le 17/10/2009 15:50:03
Bonjour Jeff1494 et bienvenue sur XLpages.com 
Tu trouveras en pièce jointe une solution possible en conservant la structure de ta base de données d'origine.
Le module de code du Userform est le suivant :
Option Explicit
'---------------------------------------------------------------------------------------
' Auteur : Didier FOURGEOT (myDearFriend!) - www.mdf-xlpages.com
' Date : 17/10/2009
'---------------------------------------------------------------------------------------
Dim TabTemp As Variant
Private Sub UserForm_Initialize()
Dim L As Long
'Mémorise les données dans un tableau variant temporaire
With Sheets("Données")
L = .Cells(.Rows.Count, 1).End(xlUp).Row
TabTemp = .Range(.Cells(2, 1), .Cells(L, 6)).Value
End With
'Remplissage du ComboBox1
RemplirCbo 1, ""
End Sub
Private Sub ComboBox1_Change()
'Remplissage Combo2
RemplirCbo 2, ComboBox1.Text
End Sub
Private Sub ComboBox2_Change()
'Remplissage Combo3
RemplirCbo 3, ComboBox2.Text
End Sub
Private Sub ComboBox3_Change()
'Remplissage Combo4
RemplirCbo 4, ComboBox3.Text
End Sub
Private Sub ComboBox4_Change()
'Remplissage Combo5
RemplirCbo 5, ComboBox4.Text
End Sub
Private Sub RemplirCbo(Id As Byte, T As String)
'myDearFriend! - www.mdf-xlpages.com
Dim Col As New Collection 'gestion doublons
Dim Cbo As Control
Dim L As Long
'RAZ de toutes les ComboBox suivantes (pour action rétroactive)
For L = 5 To Id Step -1
Controls("Combobox" & L).Clear
Next L
'MAJ de la prochaine ComboBox (sans doublon)
Set Cbo = Controls("Combobox" & Id)
For L = 1 To UBound(TabTemp, 1)
TabTemp(L, 6) = Application.Min(TabTemp(L, 6), Id - 1)
If Id = 1 Then 'Pour la première ComboBox
TabTemp(L, 6) = 1
On Error Resume Next
Col.Add TabTemp(L, 1), CStr(TabTemp(L, 1))
On Error GoTo 0
If Col.Count > Cbo.ListCount Then Cbo.AddItem TabTemp(L, 1)
Else 'Pour les suivantes
If TabTemp(L, Id - 1) = T Then
If TabTemp(L, 6) = Id - 1 Then
TabTemp(L, 6) = Id
On Error Resume Next
Col.Add TabTemp(L, Id), CStr(TabTemp(L, Id))
On Error GoTo 0
If Col.Count > Cbo.ListCount Then Cbo.AddItem TabTemp(L, Id)
End If
End If
End If
Next L
End Sub
Private Sub CommandButton1_Click()
Unload UserForm1
End Sub
En espérant t'avoir aidé...
Cordialement,
EDITION :
Code VBA ci-dessus et fichier rectifiés selon la remarque (judicieuse  ) de jeff1494.
|
Didier FOURGEOT