Ratschlag für Zeitfunktion

[Carl]

Hallo Andreas.

Weiß ich. Das war auch ein Grund, warum ich die Datenbank nicht schicken wollte, weil ich weiß, dass ich nicht besonders gut drin bin. Aber Programmieren mache ich auch nur nebenbei.

zuschwer ist doch an die Tabelle gebunden

Hast Du mal die Zeitfunktion angeschaut, frmTime3?

Carl

[Carl]

Hallo, ich habe diesen Code gebastelt. Er funktioniert schon ganz gut.

Was kann man hier eventuell verbessern bzw. sieht jemand Fehler oder Ineffizienzen?

Code [Auswählen] Erweitern


Option Compare Database

Private Sub Form_Load()
On Error GoTo Err_cmdInmark
     DoCmd.GoToRecord , , acNewRec
     Forms!frmTime3!inmark = Now()
Exit_Form_Load:
     DoCmd.Save acForm, "frmTime3"
     Exit Sub
Err_cmdInmark:
     MsgBox Err.Description
     Resume Exit_Form_Load
End Sub

Private Sub Form_Timer()
         ' IDLEMINUTES determines how much idle time to wait for before
         ' running the IdleTimeDetected subroutine.
         Const IDLEMINUTES = 1

         Static PrevControlName As String
         Static PrevFormName As String
         Static ExpiredTime

         Dim ActiveFormName As String
         Dim ActiveControlName As String
         Dim ExpiredMinutes

         On Error Resume Next

         ' Get the active form and control name.

         ActiveFormName = Screen.ActiveForm.Name
         If Err Then
             ActiveFormName = "No Active Form"
             Err = 0
         End If

         ActiveControlName = Screen.ActiveControl.Name
             If Err Then
             ActiveControlName = "No Active Control"
             Err = 0
         End If

         ' Record the current active names and reset ExpiredTime if:
         '    1. They have not been recorded yet (code is running
         '       for the first time).
         '    2. The previous names are different than the current ones
         '       (the user has done something different during the timer
         '        interval).
         If (PrevControlName = "") Or (PrevFormName = "") _
           Or (ActiveFormName <> PrevFormName) _
           Or (ActiveControlName <> PrevControlName) Then
             PrevControlName = ActiveControlName
             PrevFormName = ActiveFormName
             ExpiredTime = 0
         Else
             ' ...otherwise the user was idle during the time interval, so
             ' increment the total expired time.
             ExpiredTime = ExpiredTime + Me.TimerInterval
         End If

         ' Does the total expired time exceed the IDLEMINUTES?
         ExpiredMinutes = (ExpiredTime / 1000) / 60
         If ExpiredMinutes >= IDLEMINUTES Then
             ' ...if so, then reset the expired time to zero...
             ExpiredTime = 0
             ' ...and call the IdleTimeDetected subroutine.
             IdleTimeDetected ExpiredMinutes
         End If

End Sub

Sub IdleTimeDetected(ExpiredMinutes)
On Error GoTo Err_handler
        ' Dim Msg As String
        ' Msg = "No user activity detected in the last "
        ' Msg = Msg & ExpiredMinutes & " minute(s)!"
        ' MsgBox Msg, 48
'hier wird die outmark gesetzt
     DoCmd.GoToRecord , , acLast
     Forms!frmTime3!outmark = Now()
     DoCmd.Save acForm, "frmTime3"
'hier wird eine msgbox gezeigt
Msg = MsgBox("Möchten Sie weiter arbeiten?", vbYesNo)
If Msg = vbYes Then
     DoCmd.GoToRecord , , acNewRec
     Forms!frmTime3!inmark = Now()
     DoCmd.Save acForm, "frmTime3"
  ElseIf Msg = vbNo Then
     DoCmd.Close acForm, "frmTime3", acSaveYes
     DoCmd.Quit
End If

Exit_Form_Close:
     Exit Sub
Err_handler:
     MsgBox Err.Description
     Resume Exit_Form_Close

End Sub
       
 

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo Err_cmdOutmark
     DoCmd.GoToRecord , , acLast
     Forms!frmTime3!outmark = Now()
     DoCmd.Save acForm, "frmTime3"
Exit_Form_Close:
     Exit Sub
Err_cmdOutmark:
     MsgBox Err.Description
     Resume Exit_Form_Close
End Sub

Private Sub zurueck_Click()
'DoCmd.Close acForm, "frmTime", acSaveYes
DoCmd.Save acForm, "frmTime3"
Forms!frmTime3!zurKontrolle.Requery
End Sub



Carl