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
| Dim P As Range, C1 As String, c2 As String, L As Integer
Public Function MiIputeBox(ByRef Plage As Range, Col1 As String, Col2 As String) As String
Set P = Plage: C1 = Col1: c2 = Col2
Me.Show vbModal
If L <> 0 Then MiIputeBox = Plage.Parent.Cells(L, 1).Address
End Function
Private Sub CommandButton1_Click()
Dim txt As String, I As Integer
For I = 1 To 2
If Me.Controls("TextBox" & I) = "" Then txt = txt & Me.Controls("Label" & I) & " ne peut pas être nule!" & vbCrLf
Next
If Me.TextBox2 <> "" And Not IsNumeric(Me.TextBox2) Then txt = txt & Me.Label2 & " n'est pas numérique!" & vbCrLf
If txt <> "" Then MsgBox txt: Exit Sub
L = RechercheDoubleEntre(P, Me.TextBox1, Me.TextBox2, C1, c2)
Me.Hide
End Sub
Function RechercheDoubleEntre(Plage As Range, ChercheTxt1 As String, ChercheTxt2 As String, ColCherche1 As String, ColCherche2 As String) As Long
Dim L As Long: L = 1
Do While L > 0
L = SerchXls(Plage, Plage.Cells(L, 1), ChercheTxt1, True, False)
If Not CBool(L) Then Exit Do
If Plage.Parent.Cells(L, ColCherche2) = ChercheTxt2 Then Exit Do
Loop
RechercheDoubleEntre = L
End Function
Function SerchXls(Myrange As Range, MyCellule As Range, strRecherche, EntierCell As Boolean, EnBoucle As Boolean) As Long '
On Error Resume Next
SerchXls = 0
If EntierCell = False Then Entier = xlPart Else Entier = xlWhole
SerchXls = Myrange.Cells.Find(What:=strRecherche, After:=MyCellule, LookIn:=xlFormulas, LookAt _
:=Entier, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=EntierCell).Row
If SerchXls <= MyCellule.Row And EnBoucle = False Then SerchXls = 0
End Function
Private Sub UserForm_Click()
End Sub |
