informer

Bonjour à tous,

Voici un exemple de code industrialisé pour alimenter en cascade des zones listes. Mon exemple porte sur 3 zones listes mais cette méthode à l'avantage d'être reproductible pour un nombre indéterminé de zones listes, il suffit de recopier le code de l'événement lst1_AfterUpdate sous chaque zone liste jusqu'à lst[IdxMax-1] avec les bons paramètres dans l'instance de clsParamLstBox et le tour est joué.

C'est parti et bon code!!!


Tables

3 tables

tblPere
{idPere libel
1 pere1
2 pere2}

tblPereFils
{idPere idFils libel
1 1 fils11
1 2 fils12
2 3 fils21
2 4 fils22}

tblPetitFils
{idFils idPetitFils libel
1 1 Petitfils11
1 2 Petitfils12
2 3 Petitfils21
2 4 Petitfils22}

IHM
Un formulaire "frmMain2" avec de 3 zones listes =>

Pour lst1 & lst2, lst3 les propriétés ci-dessous

1. Nombre de colonnes: 3
2. Largeur des colonnes: 0,5cm;0,5cm;3cm
3. Colonne liée :2
4. Sélection multiple : simple

Pour List1
Contenu: qryPere
Origine source : table/requête

Requêtes
qryPere

Code SQL :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
SELECT tblPere.idPere as idPere0,tblPere.idPere, tblPere.libel
FROM tblPere
UNION SELECT   "all" as idPere0,  "all" as idPere, "<All>" as libel FROM tblPere
ORDER BY idPere DESC;

Editeur VBA

module mZoneListe

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
Option Compare Database
 
Public Type clsParamLstBox
  frmName As String
  lstSelected As Integer
  lstSourceTable As String
  lstSourceId As String
  lstSourceIdx As Integer
  lstCibleTable As String
  lstCibleId As String
End Type
 
 
Public Function displayListBox(myClsParamLstBox As clsParamLstBox)
 
On Error GoTo Err_
    Dim sSQL As String, sValues As String
    Dim sLstNameCible As String
 
    sValues = selectedItems(myClsParamLstBox)
 
    With myClsParamLstBox
        sLstNameCible = "lst" & .lstSelected + 1
        sSQL = "SELECT " & .lstSourceId & "," & .lstCibleId & ", libel FROM " & .lstCibleTable & _
        IIf(sValues = "all" Or sValues = "", "WHERE " & .lstSourceId & " IN (-1)", " WHERE " & .lstSourceId & " IN (" & sValues & ")") & _
        " UNION SELECT 'all' AS " & .lstSourceId & ", 'all' AS " & .lstCibleId & ", '<All>' AS libel FROM " & .lstCibleTable & _
        " ORDER BY libel ASC"
 
        Forms(.frmName).Controls(sLstNameCible).RowSource = sSQL
        Forms(.frmName).Controls(sLstNameCible).Selected(0) = True
    End With
 
Exit_:
    Exit Function
 
Err_:
    MsgBox Err.Description
    Resume Exit      
End Function
 
 
Function selectedItems(myClsParamLstBox As clsParamLstBox) As String
 
On Error GoTo Err_
    Dim sSelectedItems As String, sValue As String
    Dim lstName As String
    Dim sLastSelectedItem As String
 
 
    With myClsParamLstBox
        lstName = "lst" & .lstSelected
        Set lstObj = Forms(.frmName).Controls(lstName)
 
        sSelectedItems = ""
        sLastSelectedItem = ""
 
        If lstObj.Selected(0) = True Then
            For i = 1 To lstObj.ListCount - 1
                If sLastSelectedItem <> lstObj.Column(1, i) Then sSelectedItems = sSelectedItems & IIf(sSelectedItems = "", lstObj.Column(1, i), "," & lstObj.Column(1, i))
            Next i
            selectedItems = sSelectedItems
        Else
            For Each idxItem In lstObj.ItemsSelected
                sSelectedItems = sSelectedItems & IIf(sSelectedItems = "", lstObj.ItemData(idxItem), "," & lstObj.ItemData(idxItem))
            Next idxItem
            selectedItems = sSelectedItems
        End If
    End With
 
Exit_:
    Exit Function
 
Err_:
    MsgBox Err.Description
    Resume Exit_
 
End Function
 
Function selectAll(myClsParamLstBox As clsParamLstBox)
On Error GoTo Err_
 
    Dim i As Integer
    Dim sLstName As String
 
    With myClsParamLstBox
      sLstName = "lst" & .lstSelected
      Set lstObj = Forms(.frmName).Controls(sLstName)
 
    If .lstSourceIdx = 0 Or .lstSourceIdx = -1 Then
        For Each idxItem In lstObj.ItemsSelected
            If idxItem > 0 Then lstObj.Selected(idxItem) = False
        Next idxItem
     Else
        lstObj.Selected(0) = False
     End If
    End With
 
Exit_:
    Exit Function
 
Err_:
    MsgBox Err.Description
    Resume Exit_
 
End Function

Dans le formulaire

Code VBA :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Private Sub Form_Load()
 
On Error GoTo Err_
 
    Me.lst1.Selected(0) = True
    Me.lst1.SetFocus
    call lst1_AfterUpdate
 
Exit_:
    Exit Sub
 
Err_:
    MsgBox Err.Description
    Resume Exit_
 
End Sub
 
 
Private Sub lst1_AfterUpdate()
On Error GoTo Err_
 
    Dim idxSelected As Integer
    Dim sFuncName As String
 
    With myClsParamLstBox
        .frmName = "frmMain2"
        .lstSelected = 1
        .lstSourceId = "idPere"
        .lstSourceTable = "tblPere"
        .lstCibleTable = "tblPereFils"
        .lstCibleId = "idFils"
 
        .lstSourceIdx = Me.lst1.ListIndex
        Call selectAll(myClsParamLstBox)
        Call displayListBox(myClsParamLstBox)
 
        Me.Controls("lst" & .lstSelected + 1).Selected(0) = True
        Call lst2_AfterUpdate
 
    End With
 
Exit_:
    Exit Sub
 
Err_:
    MsgBox Err.Description
    Resume Exit_
End Sub
 
Private Sub lst2_AfterUpdate()
On Error GoTo Err_
 
    Dim myClsParamLstBox As clsParamLstBox
    Dim idxSelected  As Integer
    Dim sFuncName As String
 
     With myClsParamLstBox
        .frmName = "frmMain2"
        .lstSelected = 2
        .lstSourceId = "idFils"
        .lstSourceTable = "tblPereFils"
        .lstCibleTable = "tblPetitFils"
        .lstCibleId = "idPetitFils"
 
        .lstSourceIdx = Me.lst2.ListIndex
        Call selectAll(myClsParamLstBox)
        Call displayListBox(myClsParamLstBox)
 
        Me.Controls("lst" & .lstSelected + 1).Selected(0) = True