Akt. Uhrzeit u. autom. speichern/beenden
13.07.2004 19:15:23
Konni
also ich fange mal so an: ....Ich habe da ein Problem
Meine Tabelle soll in einem Gruppenlaufwerk jedem zur Verfügung stehen. Nur gibt es die eine oder andere Schlafmütze, die vergisst, nach Gebrauch die Tabelle zu schließen. Folge, keiner kann mehr Eintragungen darin machen. Die Lösung habe ich mir so vorgestellt:
Ich habe zwei VBA-Tools (siehe unten) aus Hans Archiv. Das mit der aktuellen Uhrzeit ist schon integriert und funktioniert einwandfrei. In der Tabelle habe ich zwei Schaltern (Uhr ein, Uhr aus) Makros zugewiesen: Ein UpdateClock, Aus StopClock. Die aktuelle Uhrzeit ist deshalb erforderlich, weil in der Tabelle ein Countdown integriert ist, der auf einen fixen Zeitpunkt hinweisen muss.
Nun weis ich nicht, wie man das zweite Tool so integriert, dass sich die Tabelle nach einer vorgegebenen Zeit (z.B. 10 min) und nach autom. Abspeicherung auch autom. schließt (beendet).
Dies muss auch dann funktionieren, wenn jemand die laufende Uhrzeit angehalten hat!
(Zum Verständnis: Nur bei angehaltener Uhr funktioniert auch der Befehl rückgängig)
Nachstehend die Tools aus Hans Trickkiste, gegliedert nach Arbeitsmappe und Modul.
xxxxxxxxxxxxxxxxxxxxxxxxxxxxxx Arbeitsmappe xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
--------------------------------------------Aktuelle Uhrzeit-------------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopClock
End Sub
Private Sub Workbook_Open()
Updateclock
End Sub
-------------------------------------Autom. Abspeichern und Beenden----------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Zurücksetzen
End Sub
Private Sub Workbook_Open()
startzeit
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
startzeit
End Sub
-----------------------------------------------------------------------------------------------------------------
xxxxxxxxxxxxxxxxxxxxxxxxxxxxx Inhalt Modul 1 xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
--------------------------------------------Aktuelle Uhrzeit-------------------------------------------------
Public NextTime As Date
Sub Updateclock()
NextTime = Now + TimeValue("00:00:01")
[Q10] = Time
Application.OnTime NextTime, "Updateclock"
End Sub
Sub StopClock()
On Error Resume Next
Application.OnTime earliesttime:=NextTime, Procedure:="UpdateClock", Schedule:=False
On Error GoTo 0
Application.StatusBar = False
End Sub
-------------------------------------Autom. Abspeichern und Beenden----------------------------------
Option Explicit
Dim datA As Date
Sub startzeit()
On Error Resume Next
Application.OnTime EarlistTime:=datA, Procedure:="Schließen", Schedule:=False
datA = Now + CDate("0:01:0")
Application.OnTime datA, "Schließen"
End Sub
Sub Schließen()
ActiveWorkbook.Close True
End Sub
Sub Zurücksetzen()
Application.OnTime EarlistTime:=datA, Procedure:="Schließen", Schedule:=False
End Sub
Ich hoffe, nein ich weiß, dass irgend jemand von Euch eine Lösung parat hat. Zu bedenken ist dabei, dass ich als VBA-Null auf einen VBA-Code angewiesen bin. Bitte tut mir den Gefallen. Dadurch werden meine Hilferufe auf ein Minimum reduziert.
Es grüßt und dankt, Eure VBA-Null: Konni