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.
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 ?
Bonjour,
Un exemple:
http://boisgontierjacques.free.fr/pages_site/formulairecascade.htm#Cascade3N iv
JB
On 4 fév, 14:11, Nyck0las <nicolasn...@gmail.com> 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.
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 ?
Nyck0las
merci
mais j'ai un peu de mal à comprendre le code (je ne suis pas un grand expert en vba)
merci
mais j'ai un peu de mal à comprendre le code
(je ne suis pas un grand expert en vba)
mais j'ai un peu de mal à comprendre le code (je ne suis pas un grand expert en vba)
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 -
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 <boisgont...@hotmail.com> wrote:
Bonjour,
Un exemple:http://boisgontierjacques.free.fr/pages_site/formulairecascade. htm#Ca...
JB
On 4 fév, 14:11, Nyck0las <nicolasn...@gmail.com> 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 -
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 -
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)
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 <nicolasn...@gmail.com> wrote:
merci
mais j'ai un peu de mal à comprendre le code
(je ne suis pas un grand expert en vba)
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)
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
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, ... ??
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
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 !!!
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 !!!
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
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 !!!
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 <nicolasn...@gmail.com> 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 !!!
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 !!!
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)
merci beaucoup JB !!
A quoi servent les cases que tu as remplies :
Noms de champ dynamiques
An =DECALER(Feuil1!$C$2;;;NBVAL(Feuil1!$C:$C)-1)
Collectivité =DECALER(Feuil1!$A$2;;;NBVAL(Feuil1!$A:$A)-1)
Domaine =DECALER(Feuil1!$B$2;;;NBVAL(Feuil1!$B:$B)-1)
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
Ce sont les noms de champ dynamique qu'il faut créer avec la commande Insertion/Nom/Définir
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)
Ce sont les noms de champ dynamique qu'il faut créer avec la commande
Insertion/Nom/Définir
On 5 fév, 14:23, Nyck0las <nicolasn...@gmail.com> wrote:
merci beaucoup JB !!
A quoi servent les cases que tu as remplies :
Noms de champ dynamiques
An =DECALER(Feuil1!$C$2;;;NBVAL(Feuil1!$C:$C)-1)
Collectivité =DECALER(Feuil1!$A$2;;;NBVAL(Feuil1!$A:$A)-1)
Domaine =DECALER(Feuil1!$B$2;;;NBVAL(Feuil1!$B:$B)-1)
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)