Private Sub Worksheet_SelectionChange(ByVal R As Range)
Dim cel As Range
Application.EnableEvents = False
Application.ScreenUpdating = False
If Not Intersect(R, Range("p7:p20000")) Is Nothing And R.Count = 1 Then
If R = "OK" Then
Set cel = Feuil6.Columns(8).Find(ActiveCell.Offset(0, -9), LookIn:=xlValues, lookat:=xlWhole)
If Not cel Is Nothing Then
Feuil6.Activate
ActiveSheet.Cells(cel.Row, cel.Column).Activate
End If
Else
PratiqueSuivisAppels02.Show
If R = "OK" And ActiveCell.Offset(0, -7) = "" Then
CreateObject("Wscript.shell").Popup "c'est bon on passe à la feuille suivante", 1, "Bravo !!!"
Call CopieTelRdV
Sheets("Feuil1").Select
ActiveCell.Offset(0, 2) = 1
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoRestrictions
Sheets("RendezVous").Select
Exit Sub
End If
If R <> "OK" Then
ActiveSheet.Unprotect Password:=""
ActiveCell.Offset(0, -7) = ""
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoRestrictions
End If
If ActiveCell.Offset(0, -7) = 1 Then
Sheets("Feuil1").Select
CreateObject("Wscript.shell").Popup "numéro déjà enregistré dans RendezVous", 1, "Dommage !!!"
ActiveSheet.Protect Password:="", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveSheet.EnableSelection = xlNoRestrictions
End If
End If
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub