Private Sub Workbook_Open()
Dim nom$
nom = Environ("UserName")
With Feuil1 'CodeName de la feuille, à adapter
If Application.CountIf(.Range("AQ10:AQ" & .Rows.Count), nom) Then
Application.ScreenUpdating = False
.Unprotect "toto" 'mot de passe à adapter
.Range("AQ10:AQ" & .Rows.Count).Replace nom, 0, xlWhole
Intersect(.[A:J], .Range("AQ10:AQ" & .Rows.Count).SpecialCells(xlCellTypeConstants, 1).EntireRow).Locked = False 'déverrouille les cellules autorisées
.Range("AQ10:AQ" & Rows.Count).Replace 0, nom
End If
.Protect "toto", UserInterfaceOnly:=True 'mot de passe à adapter
End With
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
With Feuil1 'CodeName de la feuille, à adapter
.Protect "toto", UserInterfaceOnly:=True 'mot de passe à adapter
.Cells.Locked = True 'verrouille toutes les cellules
End With
Save 'enregistrement
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim r As Range, t, deb#, fin#, nom$, i&
With Feuil1 'CodeName de la feuille, à adapter
If Sh.Name = .Name Then
If Not Intersect(Target, .[G:J]) Is Nothing Then
Set r = Intersect(Target.EntireRow, .[G:G])
t = .Range("G10", .Range("AQ" & .Rows.Count).End(xlUp)) 'à adapter éventuellement
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next 'sécurité
For Each r In r 'si entrées/effacements multiples
If IsError(CDate(r + r(1, 2))) Or IsError(CDate(r(1, 3) + r(1, 4))) Then Application.Undo: GoTo 1
deb = r + r(1, 2): fin = r(1, 3) + r(1, 4): nom = r(1, 37)
For i = 1 To UBound(t)
If t(i, 37) <> "" Then If t(i, 37) <> nom Then _
If deb > 0 And deb >= t(i, 1) + t(i, 2) And deb <= t(i, 3) + t(i, 4) Or _
fin > 0 And fin >= t(i, 1) + t(i, 2) And fin <= t(i, 3) + t(i, 4) _
Then MsgBox "Véhicule occupé sur cette période !", 48: r.Resize(, 4) = "": Exit For
Next i, r
1 Application.EnableEvents = True 'réactive les évènements
End If
End If
End With
End Sub