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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
| Option Compare Text
Dim f, tblClé(), nbCol, ligneEnreg, colCle
Private Sub UserForm_Initialize()
Set f = Sheets("Personnel")
Set s = Sheets("Base_Donnees")
colCle = 1 ' ADAPTER
nbCol = f.[iv1].End(xlToLeft).Column
For k = 1 To nbCol
Me("label" & k).Caption = f.Cells(1, k)
Next k
For k = nbCol + 1 To 24
Me("label" & k).Visible = False
Me("textbox" & k).Visible = False
Next k
'--
n = f.[a65000].End(xlUp).Row - 1
Set d = CreateObject("scripting.dictionary")
a = f.Range("a2:a" & f.[a65000].End(xlUp).Row).Offset(, colCle - 1).Value
For i = 1 To UBound(a)
If Not d.exists(a(i, 1)) Then d(a(i, 1)) = i + 1
Next i
ReDim tblClé(1 To d.Count, 1 To 2)
i = 0
For Each c In d.keys
i = i + 1: tblClé(i, 1) = c: tblClé(i, 2) = d(c)
Next c
Call Tri2Col(tblClé, LBound(tblClé), UBound(tblClé))
Me.ComboBox1.List = tblClé
Me.ComboBox1.ListIndex = -1
End Sub
Private Sub ComboBox1_Change()
Set d1 = CreateObject("Scripting.Dictionary")
tmp = UCase(Me.ComboBox1) & "*"
For p = LBound(tblClé) To UBound(tblClé)
If UCase(tblClé(p, 1)) Like tmp Then d1(tblClé(p, 1)) = ""
Next p
If d1.Count > 0 Then
Dim b(): ReDim b(1 To d1.Count, 1 To 2)
j = 0
For p = LBound(tblClé) To UBound(tblClé)
If UCase(tblClé(p, 1)) Like tmp Then
j = j + 1
b(j, 1) = tblClé(p, 1): b(j, 2) = tblClé(p, 2)
End If
Next p
Me.ComboBox1.List = b
Me.ComboBox1.DropDown
End If
End Sub
Private Sub ComboBox1_Click()
ligneEnreg = Me.ComboBox1.Column(1)
For Z = 1 To nbCol
Me("textbox" & Z) = f.Cells(ligneEnreg, Z)
Next Z
listeExistants
End Sub
Sub listeExistants()
Me.ListBox1.Clear
i = 0
a = f.Range("a2:a" & f.[a65000].End(xlUp).Row).Resize(, nbCol)
tmp = UCase(Me.ComboBox1)
For k = 1 To UBound(a)
If UCase(a(k, colCle)) = tmp Then n = n + 1
Next k
Dim b(): ReDim b(1 To n, 1 To 4)
For k = 1 To UBound(a)
If UCase(a(k, colCle)) = tmp Then
i = i + 1
b(i, 1) = a(k, 1)
b(i, 2) = a(k, 2)
b(i, 3) = a(k, 3)
b(i, 4) = k + 1
End If
Next k
Me.ListBox1.List = b
End Sub
Private Sub ListBox1_Click()
ligneEnreg = Me.ListBox1.Column(3)
For Z = 1 To nbCol
Me("textbox" & Z) = f.Cells(ligneEnreg, Z)
Next Z
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.ComboBox1.List = tblClé
Me.ComboBox1.ListIndex = -1
Me.ComboBox1.DropDown
End Sub
Private Sub B_modif_Click()
Dim MyDate
MyDate = Date ' MyDate contient the current system date.
If Me.TextBox1 = "" Or ligneEnreg = 0 Then Me.TextBox1.SetFocus: Exit Sub
For k = 1 To nbCol
tmp = Me("TextBox" & k)
If IsNumeric(tmp) Then tmp = Val(tmp)
If IsDate(tmp) Then tmp = CDate(tmp)
f.Cells(ligneEnreg, k) = tmp
Next k
raz
ligneEnreg = f.[a65000].End(xlUp).Row + 1
UserForm_Initialize
Me.ComboBox1.ListIndex = -1
Me.ComboBox1.SetFocus
End Sub
Sub Tri2Col(a(), gauc, droi) ' Quick sort
ref = a((gauc + droi) \ 2, 1) & a((gauc + droi) \ 2, 2)
g = gauc: d = droi
Do
Do While a(g, 1) & a(g, 2) < ref: g = g + 1: Loop
Do While ref < a(d, 1) & a(d, 2): d = d - 1: Loop
If g <= d Then
For k = LBound(a, 2) To UBound(a, 2)
temp = a(g, k): a(g, k) = a(d, k): a(d, k) = temp
Next k
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droi Then Call Tri2Col(a, g, droi)
If gauc < d Then Call Tri2Col(a, gauc, d)
End Sub
Private Sub B_nouv_Click()
ligneEnreg = f.[a65000].End(xlUp).Row + 1
raz
Me.TextBox1.SetFocus
End Sub
Sub raz()
Dim c As Control
For Each c In Me.Controls
Select Case TypeName(c)
Case "TextBox"
c.Value = ""
End Select
Next c
Me.ListBox1.Clear
End Sub |
