Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel [VBA Excel] Listbox

[VBA Excel] Listbox

28 réponses
Avatar
Nyck0las
Bonjour,

Je suis en train de travailler sur une base de donn=E9es et je voudrais
r=E9aliser un userform qui me permettrait de s=E9lectionner l'=E9l=E9ment qu=
i
servira de r=E9f=E9rence dans la suite de mon =E9tude.

En gros pour choisir cette r=E9f=E9rence, il me faut croiser 3 colonnes
- nom
- ann=E9e
- domaine
Il peut y avoir des redondances (un m=EAme nom =E0 diverses ann=E9es et pour=

divers domaines)

En gros ce que je souhaiterais faire, ce sont 3 listbox qui
reprendrais ces 3 colonnes nom, domaine et ann=E9e, sans doublon,
class=E9e par ordra alphanum=E9riqueet quand je s=E9lectionne un =E9lement
d'une colonne cel=E0 enl=E8ve des choix dans les autres.
C=E0 correspond en fait aux filtres automatiques sur ces 3 colonnes,
mais je souhaite une m=E9thode d=E9tourn=E9e pour que l'utilisateur n'ait
pas acc=E8s =E0 la base de donn=E9es directement.

Est-ce que quelqu'un aurait une petite piste ?
Signaler un problème avec ce contenu

10 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
1 2 3
Avatar
JB
Bonjour,

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

JB


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


Avatar
Nyck0las
merci

mais j'ai un peu de mal à comprendre le code
(je ne suis pas un grand expert en vba)
Avatar
JB
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 wrote:
Bonjour,

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

JB

On 4 fév, 14:11, Nyck0las wrote:



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 -



Avatar
JB
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 wrote:
merci

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


Avatar
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
Avatar
JB
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 wrote:
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


Avatar
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 !!!
Avatar
JB
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 wrote:
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 !!!


Avatar
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)
Avatar
JB
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 wrote:
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)


1 2 3