[VBA Excel] Listbox

Nyck0las Messages postés 43 Date d'inscription   Statut Membre -  
Nyck0las Messages postés 43 Date d'inscription   Statut Membre -
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 ?
Configuration: Windows XP
Internet Explorer 6.0

1 réponse

  1. Nyck0las Messages postés 43 Date d'inscription   Statut Membre 1
     
    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