Zeiteintrag in Tabelle wenn PC in Sleeptime geht?

Sub ZeitEintragen() ' Zeile nach unten verschieben und Format übertragen If Cells(4, 3) = "" Then Exit Sub Range(Cells(4, 1), Cells(4, 6)).Select Selection.Copy Selection.Insert Shift:=xlDown Application.CutCopyMode = False Range(Cells(4, 1), Cells(4, 6)).ClearContents Cells(4, 1) = Format(Date, "dd.mm.yyyy") Cells(4, 2) = Format(Time, "hh:mm:ss") Range("B4").Select ActiveWorkbook.Save End Sub

Sub ZeitAustragen() ' Endzeit in Spalte C eintragen Dim LZL As Long Dim i As Long Sheets("Zeiterfassung").Activate ' LZL = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row Cells(4, 3) = Format(Time, "hh:mm:ss") ' Dauer berechnen und in Spalte D eintragen Cells(4, 4).Select Selection.NumberFormat = "hh:mm:ss;@" Cells(4, 4) = Cells(4, 3) - Cells(4, 2) Cells(4, 1).Select ZeitGesamt ActiveWorkbook.Save End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Da du noch nicht geantwortet hast, hab ich schon mal was vorbereitet.
Ich weiss leider nicht, wie du die beiden Subs aufrufst, die du gepostet hast.
Versuch mal folgendes:
Kopiere diesen Code in ein leeres Modul:

Public dTime As Date
Type LASTINPUTINFO
cbSize As Long
dwTime As Long
End Type
Declare Sub GetLastInputInfo Lib "user32" (ByRef plii As LASTINPUTINFO)
Declare Function GetTickCount Lib "kernel32" () As Long
Function IdleTime() As Single
Dim a As LASTINPUTINFO
a.cbSize = LenB(a)
GetLastInputInfo a
IdleTime = (GetTickCount - a.dwTime) / 1000
End Function
Sub TestIdleTime()
If IdleTime >= 10 * 60 Then
Call ZeitAustragen
Else
StartTimer
End If
End Sub
Sub StartTimer()
dTime = Now + TimeValue("00:00:03")
Application.OnTime dTime, "TestIdleTime", , True
End Sub
Sub StopTimer()
On Error Resume Next
dTime = Now + TimeValue("00:00:03")
Application.OnTime dTime, "TestIdleTime", , False
End Sub

Die Zeit, in der keine Tastatur oder Maus benutzt wird (idle Time), hab ich mal auf 10 min gesetzt.
Nach dieser "untaetigen" Zeit wird deine Sub ZeitAustragen aufgerufen, also wird die Endzeit eingetragen in deinem Sheet "Zeiterfassung".
Um den Timer zu starten, ist es wohl am besten, das im Workbook_Open event zu machen. Also so:

Private Sub Workbook_Open()
StartTimer
End Sub

Aber der Timer sollte auch gestoppt werden, wenn das Workbook geschlossen wird, also:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
StopTimer
End Sub

Probiers mal aus und sag bescheid, wenn du noch Hilfe brauchst.
Gruss Torsten

Beliebteste Forumthreads (12 Monate)

Zeiteintrag in Tabelle wenn PC in Sleeptime geht?

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread