[VBA Excel] Listbox

Le
Nyck0las
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 qu=
i
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 ?
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses Page 1 / 3
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
JB
Le #5147991
Bonjour,

Un exemple:
http://boisgontierjacques.free.fr/pages_site/formulairecascade.htm#Cascade3N iv

JB


On 4 fév, 14:11, Nyck0las
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 po ur
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 ?


Nyck0las
Le #5147871
merci

mais j'ai un peu de mal à comprendre le code
(je ne suis pas un grand expert en vba)
JB
Le #5147701
http://cjoint.com/?cetC2dzEWK

Private Sub UserForm_Initialize()
Ch_Nom
Ch_An
Ch_Domaine
On Error Resume Next
ActiveSheet.ShowAllData
End Sub

Private Sub Nom_DropButtonClick()
Ch_Nom
End Sub

Private Sub An_DropButtonClick()
Ch_An
End Sub

Private Sub Domaine_DropButtonClick()
Ch_Domaine
End Sub

Private Sub Nom_Change()
filtre
End Sub

Private Sub An_Change()
filtre
End Sub

Private Sub Domaine_Change()
filtre
End Sub

Sub Ch_Nom()
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To Range("nom").Count
If Range("domaine")(i) Like Me.Domaine And CStr(Range("an")(i))
Like Me.An Then
temp = Range("nom")(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.Nom.List = temp
End Sub

Sub Ch_An()
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To Range("an").Count
If Range("nom")(i) Like Me.Nom 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("nom")(i) Like Me.Nom And CStr(Range("an")(i)) Like Me.An
Then 'And Range("an")(i) = val(Me.An)
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()
On Error Resume Next
ActiveSheet.ShowAllData
[A5].AutoFilter Field:=1, Criteria1:=Me.Nom
If Me.An <> "*" Then [A5].AutoFilter Field:=2, Criteria1:=Me.An
[A5].AutoFilter Field:=3, Criteria1:=Me.Domaine
End Sub



JB

On 4 fév, 14:37, JB
Bonjour,

Un exemple:http://boisgontierjacques.free.fr/pages_site/formulairecascade. htm#Ca...

JB

On 4 fév, 14:11, Nyck0las


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émen t 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 éleme nt
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'ai t
pas accès à la base de données directement.

Est-ce que quelqu'un aurait une petite piste ?- Masquer le texte des mes sages précédents -


- Afficher le texte des messages précédents -



JB
Le #5147681
http://cjoint.com/?cetG7Hhim7

Private Sub UserForm_Initialize()
Ch_Nom
Ch_An
Ch_Domaine
On Error Resume Next
ActiveSheet.ShowAllData
End Sub

Private Sub Nom_DropButtonClick()
Ch_Nom
End Sub

Private Sub An_DropButtonClick()
Ch_An
End Sub

Private Sub Domaine_DropButtonClick()
Ch_Domaine
End Sub

Private Sub Nom_Change()
filtre
End Sub

Private Sub An_Change()
filtre
End Sub

Private Sub Domaine_Change()
filtre
End Sub

Sub Ch_Nom()
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To Range("nom").Count
If Range("domaine")(i) Like Me.Domaine And CStr(Range("an")(i))
Like Me.An Then
temp = Range("nom")(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.Nom.List = temp
End Sub

Sub Ch_An()
Set MonDico = CreateObject("Scripting.Dictionary")
For i = 1 To Range("an").Count
If Range("nom")(i) Like Me.Nom 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("nom")(i) Like Me.Nom And CStr(Range("an")(i)) Like Me.An
Then 'And Range("an")(i) = val(Me.An)
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()
On Error Resume Next
ActiveSheet.ShowAllData
[A5].AutoFilter Field:=1, Criteria1:=Me.Nom
If Me.An <> "*" Then [A5].AutoFilter Field:=2, Criteria1:=Me.An
[A5].AutoFilter Field:=3, Criteria1:=Me.Domaine
End Sub


JB


On 4 fév, 16:17, Nyck0las
merci

mais j'ai un peu de mal à comprendre le code
(je ne suis pas un grand expert en vba)


Nyck0las
Le #5283441
wow merci beaucoup pour le code, c'est exactement ce que je voulais.

J'aurais quand même 1-2 question pour que je comprenne bien comment çà
marche.

- Où est-ce que tu définis et à quoi servent exactement les Me.An,
Me.Domaine, ... ??

- je ne comprends pas bien la procédure filtre
JB
Le #5283421
Bonjour,

Nom,An,Domaine sont les noms des TextBox du formulaire (voir propriété
Nom du textbox). Me. n'est pas obligatoire.

http://boisgontierjacques.free.fr/pages_site/formulairebases.htm
http://boisgontierjacques.free.fr/fichiers/Formulaire/FormCascade3Niveaux2.x ls

JB
http://boisgontierjacques.free.fr

On 5 fév, 11:07, Nyck0las
wow merci beaucoup pour le code, c'est exactement ce que je voulais.

J'aurais quand même 1-2 question pour que je comprenne bien comment ç à
marche.

- Où est-ce que tu définis et à quoi servent exactement les Me.An,
Me.Domaine, ... ??

- je ne comprends pas bien la procédure filtre


Nyck0las
Le #5283401
j'ai adapté un mini schouilla ton code pour le faire coller davantage
à mon cas mais çà bugge et je ne vois vraiment pas d'où viens le
problème. J'ai vraiment quasiment rien changé ...

http://cjoint.com/?cfmqadQ06c

JB, est-ce que tu pourrais regarder ???

nb : je suis retourné faire un tour sur ton site, t'es vraiement un
pro d'excel vba !!!
JB
Le #5283381
http://cjoint.com/?cfmVsN3YaU

Private Sub UserForm_Initialize()
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()
On Error Resume Next
ActiveSheet.ShowAllData
[A1].AutoFilter Field:=1, Criteria1:=Me.Collectivité
If Me.An <> "*" Then [A1].AutoFilter Field:=3, Criteria1:=Me.An
[A1].AutoFilter Field:=2, Criteria1:=Me.Domaine
End Sub

JB

On 5 fév, 12:19, Nyck0las
j'ai adapté un mini schouilla ton code pour le faire coller davantage
à mon cas mais çà bugge et je ne vois vraiment pas d'où viens le
problème. J'ai vraiment quasiment rien changé ...

http://cjoint.com/?cfmqadQ06c

JB, est-ce que tu pourrais regarder ???

nb : je suis retourné faire un tour sur ton site, t'es vraiement un
pro d'excel vba !!!


Nyck0las
Le #5283291
merci beaucoup JB !!

A quoi servent les cases que tu as remplies :

Noms de champ dynamiques
An ÞCALER(Feuil1!$C$2;;;NBVAL(Feuil1!$C:$C)-1)
Collectivité ÞCALER(Feuil1!$A$2;;;NBVAL(Feuil1!$A:$A)-1)
Domaine ÞCALER(Feuil1!$B$2;;;NBVAL(Feuil1!$B:$B)-1)
JB
Le #5283261
Ce sont les noms de champ dynamique qu'il faut créer avec la commande
Insertion/Nom/Définir

http://boisgontierjacques.free.fr/pages_site/noms.htm#NomChampDyn

JB

On 5 fév, 14:23, Nyck0las
merci beaucoup JB !!

A quoi servent les cases que tu as remplies :

Noms de champ dynamiques
An      ÞCALER(Feuil1!$C$2;;;NBVAL(Feuil1!$C:$C)-1)
Collectivité   ÞCALER(Feuil1!$A$2;;;NBVAL(Feuil1!$A:$A)-1)
Domaine ÞCALER(Feuil1!$B$2;;;NBVAL(Feuil1!$B:$B)-1)


Publicité
Poster une réponse
Anonyme