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
| Option Compare Text
Dim f, ligneEnreg, Tblclé()
Private Sub UserForm_Initialize()
Set f = Sheets("BD")
Tblclé = Range("A2:D" & [a65000].End(xlUp).Row).Value ' Nom+Prénom
For i = 1 To UBound(Tblclé): Tblclé(i, 3) = f.Cells(i + 1, 7): Next i ' ville
For i = 1 To UBound(Tblclé): Tblclé(i, 4) = i + 1: Next i ' index
Call Tri2Col(Tblclé, LBound(Tblclé), UBound(Tblclé))
Me.ChoixNom.List = Tblclé
Me.ChoixNom.SetFocus
End Sub
Private Sub ChoixNom_click()
'on récupère tous les champs
ligneEnreg = Me.ChoixNom.Column(3)
AfficheFiche
Me.ListBox1.Clear
Me.Existant.Caption = ""
listeExistants
End Sub
Sub AfficheFiche()
For Each c In Me.Frame_Civilite.Controls
If f.Cells(ligneEnreg, 3) = c.Caption Then c.Value = True
Next c
Me.Controls("TextBox1") = f.Cells(ligneEnreg, 1)
Me.Controls("TextBox2") = f.Cells(ligneEnreg, 2)
For k = 3 To 6
Me.Controls("TextBox" & k) = f.Cells(ligneEnreg, k + 1)
Next k
End Sub
Private Sub B_nouv_Click()
ligneEnreg = [a65000].End(xlUp).Row + 1
raz
Me.TextBox1.SetFocus
End Sub
Private Sub B_valid_Click()
If Me.TextBox1 = "" Or ligneEnreg = 0 Then Me.TextBox1.SetFocus: Exit Sub
f.Cells(ligneEnreg, 1) = Me.Controls("TextBox1")
f.Cells(ligneEnreg, 2) = Me.Controls("TextBox2")
For Each c In Me.Frame_Civilite.Controls
If c Then f.Cells(ligneEnreg, 3) = c.Caption
Next c
For k = 3 To 6
tmp = Me("TextBox" & k)
If IsNumeric(tmp) Then tmp = Val(tmp)
If IsDate(tmp) Then tmp = CDate(tmp)
f.Cells(ligneEnreg, k + 1) = tmp
Next k
raz
UserForm_Initialize
ligneEnreg = f.[a65000].End(xlUp).Row + 1
End Sub
Sub raz()
Dim c As Control
For Each c In Me.Controls
Select Case TypeName(c)
Case "TextBox"
c.Value = ""
Case "CheckBox"
c.Value = False
Case "ListBox", "ComboBox"
c.ListIndex = -1
Case "Frame"
For Each b In c.Controls
If TypeName(b) = "OptionButton" Then b.Value = False
Next b
End Select
Next c
Me.ListBox1.Clear
Me.Existant.Caption = ""
End Sub
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
listeExistants
End Sub
Sub listeExistants()
Me.Existant.Caption = Me.TextBox1 & " existants"
Me.ListBox1.Clear
i = 0
For Each c In Range("A2:a" & [a65000].End(xlUp).Row)
If UCase(c) = UCase(Me.TextBox1) Then
Me.ListBox1.AddItem c
Me.ListBox1.List(i, 1) = c.Offset(, 1)
Me.ListBox1.List(i, 2) = c.Offset(, 6)
Me.ListBox1.List(i, 3) = c.Row
i = i + 1
End If
Next c
End Sub
Private Sub ListBox1_Click()
ligneEnreg = Me.ListBox1.Column(3)
AfficheFiche
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 |
Partager