Option Compare Text
Dim T1(), T(), x As Long, i As Long, y As Long, z As Long, w As Long, c As Byte, r As Byte, b As Byte, a As Variant
Private Sub UserForm_Initialize()
T = Feuil2.Range("c9:n" & Feuil2.Cells(Rows.Count, 3).End(3).Row): listbox1.List = T
liste_Click
End Sub
Private Sub liste_Click()
b = 1
T = Feuil2.Range("c9:n" & Feuil2.Cells(Rows.Count, 3).End(3).Row): C1.List = T
Label4.Caption = "Nb... " & listbox1.ListCount: es
End Sub
Private Sub C1_Click()
c = 1: est
End Sub
Private Sub x1_Change()
c = 2: If x1 <> "" Then est Else esv
End Sub
Private Sub listbox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
'If listbox1.ListIndex < 1 Then Exit Sub
For y = 1 To 12: Me("Tb" & y) = listbox1.List(listbox1.ListIndex, y - 1): Next y
Frame1.Visible = 1
End Sub
Private Sub fermer_Click()
Unload Me
End Sub
Private Sub Suppr_Click()
If b = 1 Then a = listbox1.ListIndex + 12 Else a = listbox1.List(listbox1.ListIndex, 8)
Feuil1.Rows(a).Delete: esv
End Sub
Private Sub nouv_Click()
For y = 1 To 12
If Me("Tb" & y) = "" And y <> 8 Then MsgBox "Attention renseignement vide !!": Exit Sub
Next y
For y = 1 To 12: Feuil1.Cells(listbox1.ListCount + 12, y + 2) = Me("Tb" & y).Value: Next y
esv
End Sub
Private Sub Modif_Click()
For y = 1 To 12
If Me("Tb" & y) = "" And y <> 8 Then MsgBox "Attention renseignement vide !!": Exit Sub
Next y
If b = 1 Then a = listbox1.ListIndex + 12 Else a = listbox1.List(listbox1.ListIndex, 12)
For y = 1 To 12: Feuil1.Cells(a, y + 2) = Me("Tb" & y).Value: Next y
esv
End Sub
Sub es()
Frame1.Visible = 0
For y = 1 To 12: Me("Tb" & y).Value = "": Next y
End Sub
Sub esv()
For y = 1 To 12: Me("Tb" & y).Value = "": Next y
UserForm_Initialize
liste_Click: listbox1 = "": listbox1.ListIndex = 0: x1 = ""
Label4.Caption = "Nb... " & listbox1.ListCount
Frame1.Visible = 0
End Sub
Sub est()
On Error Resume Next
For y = 1 To 3
If Me("O" & y) Then r = Me("O" & y).Tag
Next y
b = 2
T = Feuil2.Range("c9:n" & Feuil1.Cells(Rows.Count, 3).End(3).Row).Value
x = 1: w = 8
If c = 1 Then
For i = 1 To UBound(T)
w = w + 1
If T(i, 1) = C1.Text Then
T(i, 12) = w
ReDim Preserve T1(1 To 12, 1 To x)
For k = 1 To 12
T1(k, x) = T(i, k)
Next k: x = x + 1: End If: Next i
Else
For i = 1 To UBound(T)
w = w + 1
If Left(T(i, r), Len(x1)) = Left(x1, Len(x1)) Then
T(i, 12) = w
ReDim Preserve T1(1 To 12, 1 To x)
For k = 1 To 12
T1(k, x) = T(i, k)
Next k: x = x + 1: End If: Next i
End If
listbox1.Column = T1
Label4.Caption = "Nb... " & listbox1.ListCount
Erase T, T1
es
End Sub
Private Sub Tb3_keyPress(ByVal keyAscii As MSForms.ReturnInteger)
If InStr("0123456789 ", Chr(keyAscii)) = 0 Then keyAscii = 0
End Sub
Private Sub Tb4_keyPress(ByVal keyAscii As MSForms.ReturnInteger)
If InStr("0123456789 ", Chr(keyAscii)) = 0 Then keyAscii = 0
End Sub
Private Sub Tb7_keyPress(ByVal keyAscii As MSForms.ReturnInteger)
If InStr("0123456789", Chr(keyAscii)) = 0 Then keyAscii = 0
End Sub
Private Sub Reset_Click()
Unload Me: Clients.Show
End Sub