AW: Beenden automatisieren, wenn Zeit überschritten
12.06.2004 00:51:22
Heinz
Hallo Andy,
ich habe das mal für eine Mappe mit Hajo entwickelt
In diese Arbeitsmappe folgende Makros:
Option Explicit
'
Private Sub Workbook_Open()
DaZeit = "0:10:00" 'hier die Zeit ändern in "0:05:00"
ThisWorkbook.Worksheets("Eingabetabelle").Range("A1") = CDate(DaZeit)
Zeitmakro
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error Resume Next
Application.OnTime EarliestTime:=ET, Procedure:="Zeitmakro", Schedule:=False
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
ThisWorkbook.Worksheets("Eingabetabelle").Range("A1") = DaZeit
End Sub
In ein Modul:
Option Explicit
Public ET As Variant
Public DaZeit As Date
Sub Zeitmakro()
ThisWorkbook.Worksheets("Eingabetabelle").Range("A1") = ThisWorkbook.Worksheets("Eingabetabelle").Range("A1") - CDate("00:00:01")
If ThisWorkbook.Worksheets("Eingabetabelle").Range("A1") 0 Then
ET = Now + TimeValue("00:00:01")
Application.OnTime ET, "Zeitmakro"
Else
ThisWorkbook.Close True 'speichern
' Meldung bei Excel immer in Vordergrund
' Dim mldg
' mldg = MsgBox("Endzeit erreicht", 1048576, "Endzeit")
' 1048576 entspricht vbMsgBoxRtlReading
End If
End Sub
Sub MacrosON()
'Dieses Macro ausführen wenn der Code zwischen
'Application.EnableEvents = False und
'Application.EnableEvents = True
'angehalten wurde oder abstürzt
Application.EnableEvents = True
End Sub
Ich hoffe, dass ich alles herauskopiert habe was du brauchst. Teste mal.
Gruß Heinz