Sub AjouteSeance()
Dim J As Long
'Dim Sh As Shape
Dim Serie As Integer, N As Integer
Dim Q As Range
Dim Cel As Range
For J = 3 To 8
If Range("C" & J) <> 0 Then
Serie = J - 2
ActiveSheet.Unprotect
Set Q = Range("Serie" & Serie)
For N = 1 To Q.Rows.Count
If Q.Cells(N, 1) = "" Then
If Not IsError(Application.Match(CSng(Date), Columns("A"), 0)) Then 'Interdire séance le même jour
MsgBox "Une séance existe déjà à cette date" 'Interdire séance le même jour
Else 'Interdire séance le même jour
Q.Cells(N, 1).Value = 1
Q.Cells(N, 1).Interior.ColorIndex = 3
Q.Cells(N, 3).Value = Range("K10") ' Nom du médecin
Q.Cells(N, 4).Value = Range("L10") ' Nom du Kiné ou de l'Ostéo
Q.Cells(N, 2).Value = Cells(Serie + 2, "C")
Q.Cells(N, 2).Interior.ColorIndex = 15 'Ajout Couleur Gris (15)
Application.Goto Q.Cells(1, 1).Offset(-1), Scroll:=True
End If 'Interdire séance le même jour
Exit For
End If
Next N
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True
Exit Sub
End If
Next J
MsgBox " Impossible d'afficher la séance pour les raisons suivantes :" & vbCr & vbCr & " 1 - Série terminée" & vbCr & vbCr & " 2 - Renseigner le nombre de séances prescrites pour la prochaine série" & vbCr & vbCr & " 3 - Toutes les séries sont complètes"
End Sub