[VBA Excel] Listbox

Fermé
Nyck0las Messages postés 83 Date d'inscription jeudi 22 novembre 2007 Statut Membre Dernière intervention 4 septembre 2014 - 4 févr. 2008 à 14:05
Nyck0las Messages postés 83 Date d'inscription jeudi 22 novembre 2007 Statut Membre Dernière intervention 4 septembre 2014 - 8 févr. 2008 à 15:40
Bonjour,

Je suis en train de travailler sur une base de données et je voudrais réaliser un userform qui me permettrait de sélectionner l'élément qui servira de référence dans la suite de mon étude.

En gros pour choisir cette référence, il me faut croiser 3 colonnes
- nom
- année
- domaine
Il peut y avoir des redondances (un même nom à diverses années et pour divers domaines)

En gros ce que je souhaiterais faire, ce sont 3 listbox qui reprendrais ces 3 colonnes nom, domaine et année, sans doublon, classée par ordra alphanumériqueet quand je sélectionne un élement d'une colonne celà enlève des choix dans les autres.
Cà correspond en fait aux filtres automatiques sur ces 3 colonnes, mais je souhaite une méthode détournée pour que l'utilisateur n'ait pas accès à la base de données directement.

Est-ce que quelqu'un aurait une petite piste ?
A voir également:

1 réponse

Nyck0las Messages postés 83 Date d'inscription jeudi 22 novembre 2007 Statut Membre Dernière intervention 4 septembre 2014 1
8 févr. 2008 à 15:40
J’ai trouvé la solution à mon pb sur les sites :
https://silkyroad.developpez.com/VBA/ControlesUserForm/#LII-C
et
http://boisgontierjacques.free.fr/pages_site/formulairecascade.htm
et voici le résultat :

Private Sub userform_initialize()

'codage des noms des champs dynamiques
ActiveWorkbook.Names.Add Name:="An", RefersTo:="=OFFSET(Cells(2,ColA),,,CountA((" & Columns(ColA).Address & ") - 1)"
ActiveWorkbook.Names.Add Name:="Collectivité", RefersTo:="=OFFSET(Cells(2,ColC),,,CountA(" & Columns(ColC).Address & ") - 1)"
ActiveWorkbook.Names.Add Name:="Domaine", RefersTo:="=OFFSET(Cells(2,ColD),,,CountA(" & Columns(ColD).Address & ") - 1)"

Ch_Nom
Ch_An
Ch_Domaine
On Error Resume Next
ActiveSheet.ShowAllData

End Sub

Private Sub Collectivité_DropButtonClick()
Ch_Nom
End Sub

Private Sub Domaine_DropButtonClick()
Ch_Domaine
End Sub

Private Sub An_DropButtonClick()
Ch_An
End Sub

Private Sub An_Change()
filtre
End Sub

Private Sub Domaine_Change()
filtre
End Sub

Private Sub Collectivité_Change()
filtre
End Sub

Sub Ch_Nom()
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To Range("Collectivité").Count
If Range("Domaine")(i) Like Me.Domaine And CStr(Range("An")(i)) Like Me.An Then
temp = Range("Collectivité")(i)
If Not MonDico.Exists(temp) Then
MonDico.Add temp, temp
End If
End If
Next i
MonDico.Add "*", "*"
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.Collectivité.list = temp
End Sub

Sub Ch_An()
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To Range("An").Count
If Range("Collectivité")(i) Like Me.Collectivité And Range("Domaine")(i) Like Me.Domaine Then
temp = Range("An")(i)
If Not MonDico.Exists(temp) Then
MonDico.Add temp, temp
End If
End If
Next i
MonDico.Add "*", "*"
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.An.list = temp
End Sub

Sub Ch_Domaine()
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To Range("Domaine").Count
If Range("Collectivité")(i) Like Me.Collectivité And CStr(Range("An")(i)) Like Me.An Then
temp = Range("Domaine")(i)
If Not MonDico.Exists(temp) Then
MonDico.Add temp, temp
End If
End If
Next i
MonDico.Add "*", "*"
temp = MonDico.items
Call Tri(temp, LBound(temp), UBound(temp))
Me.Domaine.list = temp
End Sub

Sub Tri(a, gauc, droi) ' Quick sort
Ref = CStr(a((gauc + droi) \ 2))
g = gauc: d = droi
Do
Do While CStr(a(g)) < Ref: g = g + 1: Loop
Do While Ref < CStr(a(d)): d = d - 1: Loop
If g <= d Then
temp = a(g): a(g) = a(d): a(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri(a, g, droi)
If gauc < d Then Call Tri(a, gauc, d)
End Sub

Sub filtre()
Dim Cellule
Cellule = Cells(1, ColP)
On Error Resume Next
ActiveSheet.ShowAllData
Cellule.AutoFilter Field:=1, Criteria1:=Me.Collectivité
If Me.An <> "*" Then Cellule.AutoFilter Field:=3, Criteria1:=Me.An
Cellule.AutoFilter Field:=2, Criteria1:=Me.Domaine
End Sub

Private Sub B_OK_Click()
CollectR = Me.Collectivité
DomR = Me.Domaine
AnR = Me.An
Call LigneRef
ActiveSheet.ShowAllData
Unload ChxRef
End Sub

Sub LigneRef()
Dim ligne As Integer
If Range("A:A").SpecialCells(xlCellTypeVisible).Areas(1).Count > 1 Then
ligne = 2 'pas de filtre
Else 'il y a un filtre
ligne = Range("A:A").SpecialCells(xlCellTypeVisible).Areas(2).Item(1).Row
End If
LgR = ligne
End Sub

mais par contre j’ai un problème maintenant pour nommer mes champs dynamiques car je ne sais pas à l’avance que la plage nommé An sera dans la colonne C. Ce que j’ai marqué dans le code ci-dessus ne marche pas et me provoque l’erreur d’exécution 1004
Il faudrait donc pouvoir nommer le champ avec un nom de colonne variable, mais je ne sais pas comment faire …

La syntaxe basique est la suivante :
ActiveWorkbook.Names.Add Name:="An", RefersTo:="=OFFSET($C$2,,,CountA($C:$C) - 1)"
1