Option Explicit
Private Sub Worksheet_Activate()
Range("B10").Select
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Sheets("patients").Unprotect ("estherzina")
Dim colonne1a As String
Dim cellule As Range
Dim dl1 As Long ' dernière ligne
Dim lig As Long
Dim i As Integer
If Target.Address <> "$B$10" Then Exit Sub
With Sheets("Patients")
colonne1a = ""
For i = 1 To Len(Target.Address(0, 0))
If Asc(Mid(Target.Address(0, 0), i, 1)) > 64 Then
colonne1a = colonne1a & Mid(Target.Address(0, 0), i, 1)
End If
Next i
dl1 = .Range(colonne1a & "65536").End(xlUp).Row
lig = chercheligne("Patients", Target.Value, colonne1a & "2", colonne1a & dl1)
If lig = 0 Then
Select Case MsgBox("Le patient : " & Target.Value _
& vbCrLf & "Doesn't exists :" & .Range(colonne1a & 1) _
& vbCrLf & "Do you want to add him ?" _
& vbCrLf & "" _
, vbYesNo Or vbInformation Or vbDefaultButton1, Application.Name)
Case vbYes
UserForm1.Show
Case vbNo
Exit Sub
End Select
' .Range(colonne1a & dl1 + 1) = Target.Value
End If
End With
End Sub
Function chercheligne(£feuille As String, £valeur As String, £col1d As String, £col1f As String)
Dim cel As Range
Set cel = Sheets(£feuille).Range(£col1d & ":" & £col1f).Find(What:=£valeur, LookIn:=xlValues, SearchOrder:=xlByRows, LookAt:=xlWhole)
If cel Is Nothing Then
chercheligne = 0
Else
chercheligne = cel.Row
End If
Sheets("patients").Protect ("estherzina")
End Function