ich hab mir ein Makro zusammen gebastelt. Um ehrlich zu sein ich hab es mir aus dem Internet geklauft.
Das Makro schließt nach einer bestimmten Zeit die Datei. Es funktioniert einwandfei. Das dumme ist,
dass ich die einzelnen Zellen nicht mit einem Rahmen versehen kann. Mit Rahmenlinien zeichnen, mit dem Bleistift.
Hier ist der Code. Vielleicht findet sich ja ein Profi, der mir sagt wo der Hase im Pfeffer liegt.
Vielen Dank Werner
Option Explicit ' Variablendefinition erforderlich
Public DaEt As Date ' nächste Starzeit des Makros
Public Const DaZeit As Date = "00:32:00" ' Zeitabstand prüfen
Sub Zeitmakro()
ThisWorkbook.Worksheets("Tabelle1").Range("A1") = ThisWorkbook. _
Worksheets("Tabelle1").Range("A1") - CDate("00:00:01")
If ThisWorkbook.Worksheets("Tabelle1").Range("A1") 0 Then
DaEt = Now + TimeValue("00:00:01")
Application.OnTime DaEt, "Zeitmakro"
Else
ThisWorkbook.Close False 'nicht speichern
End If
End Sub
Option Explicit ' Variablendefinition erforderlich
Private Sub Workbook_Open()
Dim Text1 As String
Dim Text2 As String
Dim text3 As String
Text1 = "Der Ofenplan schließt automatisch nach 2 Minuten. "
Text2 = "Die abgelaufende Zeit ist in der Zelle A1 zu sehen "
text3 = "Die Zeit wird nur durch eine Bearbeitung unterbrochen. "
MsgBox Text1 & vbLf & Text2 & vbLf & text3, , "Werner Meier"
' Restzeit in Zelle eintragen um eine Sekunde erhöht da gleich
'um 1 Sekunde reduziert
ThisWorkbook.Worksheets("Tabelle1").Range("A1") = DaZeit + CDate("00:00:01")
Zeitmakro ' Makro zur Prüfung starten
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime EarliestTime:=DaEt, Procedure:="Zeitmakro", Schedule:=False
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
' Restzeit in Zelle eintragen um eine Sekunde
'erhöht da gleich um 1 Sekunde reduziert
ThisWorkbook.Worksheets("Tabelle1").Range("A1") = DaZeit + CDate("00:00:01")
End Sub