AW: Zellen zwischen 16.30 und 7.00 Uhr sperren
31.03.2012 10:25:38
Hajo_Zi
Hallo Jan,
' ************************************************************* _
' Modul: DieseArbeitsmappe Typ = Element der Mappe(Sheet, Workbook, ...)
' **************************************************************
Option Explicit _
' Variablendefinition erforderlich
'**************************************************
'* H. Ziplies *
'* 31.03.12 *
'* erstellt von HajoZiplies@web.de *
'* http://Hajo-Excel.de/ *
'**************************************************
Private Sub _
Workbook_Activate()
'Sperren Starten
Sperren
End Sub
Private Sub _
Workbook_Deactivate()
'sperren Abschalten
Ende
End Sub
Private Sub _
Workbook_BeforeClose(Cancel As Boolean)
Ende ' Sperren _
beenden
End Sub
Private Sub _
Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Ende ' Sperren _
beenden
End Sub
' **************************************************************
' Modul: mdl_gesperrt Typ = Allgemeines Modul
' **************************************************************
Option Explicit ' Variablendefinition erforderlich
Option Private Module ' Makro nicht unter Extra, Makro sichtbar
'**************************************************
'* H. Ziplies *
'* 31.03.12 *
'* erstellt von HajoZiplies@web.de *
'* http://Hajo-Excel.de/ *
'**************************************************
' das Schreiben der Startzeit auf eine Variable hat den Vorteil das die
' Prozedur leichter angehalten werden kann
Public DaEt As Date ' nächste Startzeit
Public Const DaZeitEnde As Date = "16:30" ' Ende Zeit
Public Const DaZeitStart As Date = "10:23" ' Start Zeit
Public Const DaZeit As Date = "00:01:00" ' Zeitabstand prüfen
Dim WsTabelle As Worksheet
Sub Sperren()
For Each WsTabelle In Sheets
If Time <= DaZeitStart Or Time >= DaZeitEnde Then
WsTabelle.Protect ("Gruß Gott")
Else
WsTabelle.Unprotect ("Gruß Gott")
End If
Next WsTabelle
Application.OnTime Time + DaZeit, "Sperren"
End Sub
Sub Ende()
On Error Resume Next ' Fehlerroutine von Excel ausschalten
Application.OnTime EarliestTime:=DaEt, Procedure:="Sperren", Schedule:=False
On Error GoTo 0 ' Fehlerroutine von Excel einschalten
End Sub
Gruß Hajo