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
|
Option Compare Text
Dim f, ligneEnreg, ligneEnreg2, Tblclé(), tblBD(), choix1(), ligne
Private Sub ChoixNumClient_Click()
For i = 1 To UBound(choix1)
If tblBD(i, 1) = ChoixNumClient.Column(0) Then
ligneEnreg = i
For Each c In Me.Frame_Civilite.Controls
If tblBD(ligneEnreg, 4) = c.Caption Then c.Value = True
Next c
Me.Controls("TextBox1") = tblBD(ligneEnreg, 1)
Me.Controls("TextBox2") = tblBD(ligneEnreg, 2)
Me.Controls("TextBox3") = tblBD(ligneEnreg, 3)
For k = 4 To 7
Me.Controls("TextBox" & k) = tblBD(ligneEnreg, k + 1)
Next k
End If
Next i
End Sub
Private Sub ChoixNumClient_Change()
If Me.ChoixNumClient.ListIndex = -1 And IsError(Application.Match(Me.ChoixNumClient, choix1, 0)) Then
ReDim tblChoix1(1 To UBound(choix1))
tmp = UCase(Me.ChoixNumClient) & "*"
ligne = 0
For Each c In choix1
If UCase(c) Like tmp Then ligne = ligne + 1: tblChoix1(ligne) = c
Next c
If ligne > 0 Then
ReDim Preserve tblChoix1(1 To ligne)
Call Tri2(tblChoix1, LBound(tblChoix1), UBound(tblChoix1))
Me.ChoixNumClient.List = tblChoix1
Me.ChoixNumClient.DropDown
End If
Else
ChoixNumClient_Click
End If
End Sub
Private Sub ChoixNom_Change()
'ListIndex = -1 signifie qu'aucune ligne n'est sélectionnéee
If Me.ChoixNom.ListIndex = -1 And IsError(Application.Match(Me.ChoixNom, Tblclé, 0)) Then
choix2 = Application.Transpose(f.Range("B2:B" & f.[a65000].End(xlUp).Row).Value)
Call Tri2(choix2, LBound(choix2), UBound(choix2))
ReDim tblChoix2(1 To UBound(choix2))
tmp = UCase(Me.ChoixNom) & "*"
ligne = 0
For Each c In tblChoix2
If UCase(c) Like tmp Then ligne = ligne + 1: tblChoix2(ligne) = c
Next c
If ligne > 0 Then
ReDim Preserve tblChoix2(1 To ligne)
Call Tri(tblChoix2, LBound(tblChoix2), UBound(tblChoix2))
Me.ChoixNom.List = tblChoix2
Me.ChoixNom.DropDown
End If
Else
ChoixNom_click
End If
End Sub
Private Sub UserForm_Initialize()
Set f = Sheets("BD")
Tblclé = Range("B2:C" & [a65000].End(xlUp).Row).Value ' Nom+Prénom
tblBD = Range("A2:H" & [a65000].End(xlUp).Row).Value ' BD
Call Tri(Tblclé, LBound(Tblclé), UBound(Tblclé))
Me.ChoixNom.List = Tblclé
choix1 = Application.Transpose(f.Range("A2:A" & f.[a65000].End(xlUp).Row).Value)
Call Tri2(choix1, LBound(choix1), UBound(choix1))
Me.ChoixNumClient.List = choix1
ligneEnreg2 = f.[a65000].End(xlUp).Row + 1
Me.ChoixNumClient.SetFocus
End Sub
Private Sub ChoixNom_click()
'on récupère tous les champs
For i = 1 To UBound(Tblclé)
If tblBD(i, 2) = ChoixNom.Column(0) And tblBD(i, 3) = ChoixNom.Column(1) Then
ligneEnreg = i
For Each c In Me.Frame_Civilite.Controls
If tblBD(ligneEnreg, 4) = c.Caption Then c.Value = True
Next c
Me.Controls("TextBox1") = tblBD(ligneEnreg, 1)
Me.Controls("TextBox2") = tblBD(ligneEnreg, 2)
Me.Controls("TextBox3") = tblBD(ligneEnreg, 3)
For k = 4 To 7
Me.Controls("TextBox" & k) = tblBD(ligneEnreg, k + 1)
Next k
End If
Next i
End Sub
Sub Tri(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 Tri(a, g, droi)
If gauc < d Then Call Tri(a, gauc, d)
End Sub
Sub Tri2(c, gauche, droite) ' Quick sort
ref = c((gauche + droite) \ 2)
g = gauche: d = droite
Do
Do While c(g) < ref: g = g + 1: Loop
Do While ref < c(d): d = d - 1: Loop
If g <= d Then
temp = c(g): c(g) = c(d): c(d) = temp
g = g + 1: d = d - 1
End If
Loop While g <= d
If g < droite Then Call Tri2(c, g, droite)
If gauche < d Then Call Tri2(c, gauche, d)
End Sub |
Partager