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
| Option Explicit
Option Compare Text
Dim t As Variant, ta() As String, p As Long, s As Long
Dim X As Long, i As Long, j As Long, k As Long, e As Byte
Private Sub CommandButton4_Click()
Unload Me: [a1].Select
End Sub
Private Sub CommandButton5_Click()
t = Range("a8:f" & Range("a65536").End(xlUp).Row)
Lbx1.List = t
End Sub
Private Sub CommandButton7_Click()
End Sub
Private Sub OptionButton1_Click() 'option "MBA"
If Me.OptionButton1.Value = True Then 'condition : si l'option "MBA" est cochée
Call Tbx1_Change 'relance la procédure Change de la textbox Tbx1
For X = Me.Lbx1.ListCount - 1 To 0 Step -1 'boucle inversée sur tous les éléments de la listbox Lbx1
If Me.Lbx1.Column(1, X) <> "MBA" Then Me.Lbx1.RemoveItem (X) 'si la colonne 1 de l'élément est différente de "MBA" supprime l'élément
Next X 'prochain élément de la boucle
End If 'fin de la condition
End Sub
Private Sub OptionButton2_Click() 'option "Masters"
If Me.OptionButton2.Value = True Then 'condition : si l'option "Masters" est cochée
Call Tbx1_Change 'relance la procédure Change de la textbox Tbx1
For X = Me.Lbx1.ListCount - 1 To 0 Step -1 'boucle inversée sur tous les éléments de la listbox Lbx1
If Me.Lbx1.Column(1, X) <> "Masters" Then Me.Lbx1.RemoveItem (X) 'si la colonne 1 de l'élément est différente de "Masters" supprime l'élément
Next X 'prochain élément de la boucle
End If 'fin de la condition
End Sub
Private Sub OptionButton3_Click() 'option "All"
If Me.OptionButton3.Value = True Then Call Tbx1_Change 'si l'option "All" est cochée, relancela procédure Change de la textbox Tbx1
End Sub
Private Sub reset_Click()
Unload Me: UserForm1.Show
End Sub
Private Sub Tbx1_Change()
On Error Resume Next
Application.ScreenUpdating = False
t = Range("a8:q" & Range("a65536").End(xlUp).Row)
Lbx1.Clear
X = 1
For i = 1 To UBound(t)
For j = 1 To 4
If Left(t(i, j), Len(Tbx1)) = Left(Tbx1, Len(Tbx1)) Then
If Me.OptionButton3.Value = True _
Or Me.OptionButton1 = True And t(i, 2) = "MBA" _
Or Me.OptionButton2 = True And t(i, 2) = "Masters" Then
ReDim Preserve ta(1 To 17, 1 To X)
For k = 1 To 17
ta(k, X) = t(i, k)
Next k
X = X + 1
End If
End If
Next j
Next i
Lbx1.List = Application.Transpose(ta)
If X - 1 = 1 Then
For e = 1 To 17
Controls("Textbox" & e) = Lbx1.List(Lbx1.ListIndex + e)
Next e
Lbx1.Clear
End If
Erase t, ta
If Tbx1 = "" Then
Lbx1.Clear
For e = 1 To 17: Controls("Textbox" & e) = ""
Next e
Lbx1.Clear
End If
Beep
End Sub
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
If CloseMode = vbFormControlMenu Then Cancel = True
End Sub
Private Sub lbx1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Label1.Caption = ""
p = 0.02: s = Timer: Do While Timer < s + p: DoEvents: Loop
Label1.Caption = "Search"
End Sub
Private Sub CommandButton6_Click()
'Test de School name
If Me.TextBox1.Text = "" Then
MsgBox "The school name is a mandatory information"
Me.TextBox1.SetFocus
Exit Sub
End If
'Test MBA/Masters
If Me.TextBox2.Text = "" Then
MsgBox "MBA/Masters is a mandatory information"
Me.TextBox2.SetFocus
Exit Sub
End If
'Insertion des champs dans Excel
Range("A65536").End(xlUp).Offset(1, 0).Value = TextBox1
Range("A65536").End(xlUp).Offset(0, 1).Value = TextBox2
Range("A65536").End(xlUp).Offset(0, 2).Value = TextBox3
Range("A65536").End(xlUp).Offset(0, 3).Value = TextBox4
Range("A65536").End(xlUp).Offset(0, 4).Value = TextBox5
Range("A65536").End(xlUp).Offset(0, 5).Value = TextBox6
Range("A65536").End(xlUp).Offset(0, 6).Value = TextBox7
Range("A65536").End(xlUp).Offset(0, 7).Value = TextBox8
Range("A65536").End(xlUp).Offset(0, 8).Value = TextBox9
Range("A65536").End(xlUp).Offset(0, 9).Value = TextBox10
Range("A65536").End(xlUp).Offset(0, 10).Value = TextBox11
Range("A65536").End(xlUp).Offset(0, 11).Value = TextBox12
Range("A65536").End(xlUp).Offset(0, 12).Value = TextBox13
Range("A65536").End(xlUp).Offset(0, 13).Value = TextBox14
Range("A65536").End(xlUp).Offset(0, 14).Value = TextBox15
Range("A65536").End(xlUp).Offset(0, 15).Value = TextBox16
Range("A65536").End(xlUp).Offset(0, 16).Value = TextBox17
Unload Me
End Sub |
Partager