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
| Option Explicit
Dim interne As Boolean
Private Sub DTPicker1_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
End Sub
Private Sub LbxVille_Change()
Dim ch As String, i As Long, sep As String
If Not interne Then
ch = ""
sep = [Séparateur]
For i = 0 To LbxVille.ListCount - 1
If LbxVille.Selected(i) = True Then ch = ch & sep & LbxVille.List(i)
Next i
ch = Mid(ch, Len(sep) + 1)
ActiveCell = ch
End If
End Sub
Private Sub LbxVille_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
' un clic droit désélectionne ou sélectionne l'ensemble de la liste
Dim i As Long, cpt As Long, state As Boolean
If Button = xlSecondaryButton Then ' si clic-droit
' nb sélections
For i = 0 To LbxVille.ListCount - 1
If LbxVille.Selected(i) Then cpt = cpt + 1
Next i
' si aucune sélection sélectionner tout
' sinon désélectionner tout
If cpt = 0 Then state = True Else state = False
interne = True ' palliatif, EnableEvents ne marche pas
For i = 0 To LbxVille.ListCount - 1
LbxVille.Selected(i) = state
Next i
interne = False
End If
LbxVille_Change
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ch As String, ch2 As String, pos As Long, i As Long
Dim plage, nomListe, numListe As Long, topIndex As Boolean
' plages avec sélection multiple sur cette feuille
plage = Array("H5:H100", "M5:M100")
' nom des listes dans la feuille Listes (en liaison avec les plages définies au-dessus)
nomListe = Array("Ville", "Prénom")
' plage concernée ?
For numListe = 0 To UBound(plage)
If Not Intersect(Target, Range(plage(numListe))) Is Nothing Then Exit For
Next numListe
If numListe <= UBound(plage) Then ' si plage de liste existant
' initialiser listbox
LbxVille.ListFillRange = "Listes!" & Worksheets("Listes").Range(nomListe(numListe)).Address ' A2:A17" ' [Listes!Ville].Address
LbxVille.Top = Target.Offset(1, 0).Top
LbxVille.Left = Target.Offset(0, 1).Left
interne = True ' palliatif, EnableEvents ne marche pas
ch = ActiveCell
ch2 = [Séparateur] & ch & [Séparateur]
topIndex = False
' sélectionner selon contenu cellule
For i = 0 To LbxVille.ListCount - 1
If InStr(ch2, [Séparateur] & LbxVille.List(i) & [Séparateur]) > 0 Then
' l'item a été trouvé dans la cellule
LbxVille.Selected(i) = True
If Not topIndex Then
LbxVille.topIndex = i ' le 1er sélectionné doit être visible dans la textbox
topIndex = True
End If
End If
Next i
interne = False
' afficher textbox
LbxVille.Visible = True
Else
' ne plus afficher la textbox
LbxVille.Visible = False
End If
End Sub
Sub reinit()
Application.EnableEvents = True
End Sub |
