Jim Dettman
jimdettman at earthlink.net
Fri Jun 20 05:23:22 CDT 2003
Julie,
Here's how I do my time cards apps. Start/Stop times are kept as a numeric
number, along with a separate field for work date. Generally the operators
like to key it in as hhmm. Of course the other issues is 0005 five minutes
or half an hour? You can do either with this technique. I also allow for
adjustments where no start/stop time is entered, but simply an amount of
time. I do this with a -1 in the start time control. The code for the
Start time AfterUpdate event is below.
The other issue when entering start/stop times is does the start/stop
range entered overlap another card already entered. I've posted code below
for that as well. This is done in the BeforeUpdate event of the start and
stop time control.
The last thing you talked about is shift. It's difficult to do in some
cases because what's considered "normal" for each employee may be difficult
to determine. Over the years, I've settled for the technique of setting up
an employees work schedule, then flagging the time card as being "out of
shift" if it doesn't match up to the schedule.
The schedule records have the following fields:
SchedDate
Mon
Tue
Wed
Thu
Fri
Sat
Sun
NoHours
Start
Stop
The user can either indicate a specific date, or tick off the days of the
week that this should apply to. If they tick no hours, it means the
employee should not be working at all. Start/stop time indicates the normal
shift for the employee.
I've included code for everything I've mentioned above. May give you some
ideas.
HTH,
Jim Dettman
President,
Online Computer Services of WNY, Inc.
(315) 699-3443
jimdettman at earthlink.net
Private Sub txtStart_AfterUpdate()
Dim dblStartTime As Double
Dim dblStopTime As Double
If Me![txtStart] = 0 Or IsNull(Me![txtStart]) Then
' Line with no ET on it.
Me![txtStop] = 0
Me![txtET] = 0
Me![txtRegHrs] = 0
Me![txtOTHTHrs] = 0
Me![txtOTDTHrs] = 0
Me![txtStop].Enabled = False
Me![txtStop].Locked = True
Me![txtRegHrs].Enabled = False
Me![txtRegHrs].Locked = True
Me![txtOTHTHrs].Enabled = False
Me![txtOTHTHrs].Locked = True
Me![txtOTDTHrs].Enabled = False
Me![txtOTDTHrs].Locked = True
ElseIf Me![txtStart] = -1 Then
Me![txtStop] = ""
Me![txtET] = 0
Me![txtRegHrs] = 0
Me![txtOTHTHrs] = 0
Me![txtOTDTHrs] = 0
Me![txtStop].Enabled = False
Me![txtStop].Locked = True
Me![txtRegHrs].Enabled = True
Me![txtRegHrs].Locked = False
Me![txtOTHTHrs].Enabled = True
Me![txtOTHTHrs].Locked = False
Me![txtOTDTHrs].Enabled = True
Me![txtOTDTHrs].Locked = False
Else
' Use for minutes expressed as part of an hour
' i.e. start/stop time of 6.33 is 6 hours, 20 minutes
'dblStartTime = TimeSerial(Fix(Me![txtStart]), Round((Me![txtStart] -
Fix(Me![txtStart])) * 60, 0), 0)
'If IsNull(Me![txtStop]) Then
' dblStopTime = 0
'Else
' dblStopTime = TimeSerial(Fix(Me![txtStop]), Round((Me![txtStop] -
Fix(Me![txtStop])) * 60, 0), 0)
'End If
' Use for minutes expressed as minutes
' i.e. start/stop time of 6.33 is 6 hours, 33 minutes
If IsNull(Me![txtStart]) Then
dblStartTime = 0
Else
dblStartTime = TimeSerial(Fix(Me![txtStart] / 100), Me![txtStart] -
(Fix(Me![txtStart] / 100) * 100), 0)
End If
If IsNull(Me![txtStop]) Then
dblStopTime = 0
Else
dblStopTime = TimeSerial(Fix(Me![txtStop] / 100), Me![txtStop] -
(Fix(Me![txtStop] / 100) * 100), 0)
End If
' Since we only track the "start date", we need to add
' 24 hours to the stop time to indicate that the end
' time fell into another day.
If dblStopTime <= dblStartTime Then dblStopTime = dblStopTime + 1
' Calculate ET.
Me![txtET] = Round(DateDiff("n", dblStartTime, dblStopTime) / 60, 2)
Me![txtRegHrs] = Me![txtET]
Me![txtOTHTHrs] = 0
Me![txtOTDTHrs] = 0
Me![txtStop].Enabled = True
Me![txtStop].Locked = False
Me![txtRegHrs].Enabled = True
Me![txtRegHrs].Locked = False
Me![txtOTHTHrs].Enabled = True
Me![txtOTHTHrs].Locked = False
Me![txtOTDTHrs].Enabled = True
Me![txtOTDTHrs].Locked = False
End If
End Sub
=========================
rivate Sub txtStart_BeforeUpdate(Cancel As Integer)
Dim intHours As Integer
Dim intMinutes As Integer
If (Me![txtStart] <> 0) And (Me![txtStart] <> -1) Then
' Use for minutes expressed as part of an hour
' i.e. start/stop time of 6.33 is 6 hours, 20 minutes
'If Me![txtStart] > 2399 Or Me![txtStart] < 0 Then
'If Me![txtStart] > 2399 Or Me![txtStart] < 0 Then
' gstrMBTitle = "Time format error."
' gstrMBMsg = "Your start time is invalid - <0 or >2399."
' Use for minutes expressed as minutes
' i.e. start/stop time of 6.33 is 6 hours, 33 minutes
intHours = Fix(Me![txtStart] / 100)
intMinutes = Me![txtStart] - (Fix(Me![txtStart] / 100) * 100)
If Me![txtStart] < 0 Or intMinutes > 59 Then
gstrMBTitle = "Time format error."
gstrMBMsg = "Your start time is invalid - Enter as hhmm."
gintMBDef = MB_OK
gintMBLog = False
gintMBBeep = True
Call DisplayMsgBox
Cancel = True
Me![txtStart].SelStart = 0
Me![txtStart].SelLength = 255
Else
If (CheckForOverlap("B")) Then
gstrMBTitle = "Time range error."
gstrMBMsg = "Your start time is in another start/stop range."
gintMBDef = MB_OK
gintMBLog = False
gintMBBeep = True
Call DisplayMsgBox
Cancel = True
Me![txtStart].SelStart = 0
Me![txtStart].SelLength = 255
End If
End If
End If
End Sub
==================================
Private Function CheckForOverlap(strTime As String) As Integer
Dim rst As Recordset
Dim curStartTime As Currency
Dim curStopTime As Currency
Dim curRecordStartTime As Currency
Dim curRecordStopTime As Currency
Dim lngCurTranID As Long
Dim fAtNewRecord As Integer
' Routine to check if new time entry overlaps an existing time card line.
CheckForOverlap = False
On Error Resume Next
lngCurTranID = Me![TranID]
fAtNewRecord = (Err = 3021)
' Get start and stop times for current line.
curStartTime = ConvertNulls(Me![txtStart], "0")
curStopTime = ConvertNulls(Me![txtStop], "0")
If curStopTime <= curStartTime Then curStopTime = curStopTime + 2400
' Check all records in clone.
Set rst = Me.RecordsetClone
If rst.RecordCount > 0 Then
rst.MoveLast
Do Until rst.BOF
If fAtNewRecord = False Then
If lngCurTranID <> rst![TranID] Then
If Not (ConvertNulls(rst![Start], "") = "") Then
curRecordStartTime = ConvertNulls(rst![Start], "0")
curRecordStopTime = ConvertNulls(rst![Stop], "0")
If curRecordStopTime < curRecordStartTime Then curRecordStopTime
= curRecordStopTime + 2400
' Debug.Print curStartTime, curRecordStartTime
' Debug.Print curStopTime, curRecordStopTime
If curRecordStartTime > 0 And curRecordStopTime > 0 Then
If strTime = "B" Then
If curStartTime >= curRecordStartTime And curStartTime <
curRecordStopTime Then
CheckForOverlap = True
Exit Do
End If
If curStopTime <> 2400 Then
If curStartTime < curRecordStartTime And curStopTime >
curRecordStartTime Then
CheckForOverlap = True
Exit Do
End If
End If
Else
If curStartTime < curRecordStartTime And curStopTime >
curRecordStartTime Then
CheckForOverlap = True
Exit Do
End If
End If
End If
End If
End If
End If
rst.MovePrevious
Loop
End If
rst.Close
Set rst = Nothing
End Function
==================================
Public Sub LoadEmpSchedule()
Dim qrydef As QueryDef
Dim prm As Parameter
Dim rst As Recordset
Dim intK As Integer
Set qrydef = dbCurrent.QueryDefs("qryfrmTimeCardLoadEmpSched")
For intK = 0 To qrydef.Parameters.Count - 1
Set prm = qrydef.Parameters(intK)
prm.Value = Eval(prm.Name)
Next intK
Set rst = qrydef.OpenRecordset()
On Error Resume Next
rst.MoveLast
rst.MoveFirst
Erase varSchedRecords
If rst.RecordCount > 0 Then
varSchedRecords = rst.GetRows(rst.RecordCount)
lngUpperLimitofSchedRecs = UBound(varSchedRecords, 2)
Else
lngUpperLimitofSchedRecs = 0
End If
rst.Close
Set rst = Nothing
End Sub
===================================
Public Function CheckOutOfSchedule(dtWorkDate As Date, curStartTime As
Currency, curStopTime As Currency) As Integer
Dim intK As Integer
Dim intFoundMatch As Integer
Dim intDay As Integer
' Loop through schedule records checking if passed start/stop time
' is within a scheduled start/stop time.
If lngUpperLimitofSchedRecs = 0 Then
CheckOutOfSchedule = False
Exit Function
End If
CheckOutOfSchedule = True
If curStopTime <= curStartTime Then curStopTime = curStopTime + 2400
' Always check for specific dates first.
' If we hit a date that is where search date is > array date,
' or the date is null, then there is no match.
intFoundMatch = False
For intK = 0 To lngUpperLimitofSchedRecs
If IsNull(varSchedRecords(0, intK)) Then
' Hit first entry that is not date specific. Quit loop.
intK = lngUpperLimitofSchedRecs
Else
If dtWorkDate > varSchedRecords(0, intK) Then
' Hit entry with date that is < search date. No date specific
' match can be found. Quit loop.
intK = lngUpperLimitofSchedRecs
Else
intFoundMatch = True
' First check if day flagged for no hours.
If varSchedRecords(8, intK) = True Then
' Day flagged for no hours
CheckOutOfSchedule = True
intK = lngUpperLimitofSchedRecs
Else
If curStartTime < varSchedRecords(9, intK) Or curStartTime >
varSchedRecords(10, intK) Or curStopTime < varSchedRecords(9, intK) Or
curStopTime > varSchedRecords(10, intK) Then
' times falls outside of scheduled time, go look for next one.
Else
' Have a record where were OK. Quit.
CheckOutOfSchedule = False
intK = lngUpperLimitofSchedRecs
End If
End If
End If
End If
Next intK
If intFoundMatch = True Then Exit Function
' Now check general days.
intDay = WeekDay(dtWorkDate, vbMonday)
For intK = lngUpperLimitofSchedRecs To 0 Step -1
If Not IsNull(varSchedRecords(0, intK)) Then
' Hit first entry that is not date specific. Quit loop.
intK = 0
Else
If varSchedRecords(intDay, intK) = False Then
' This sched rec does not apply to this day.
Else
intFoundMatch = True
' First check if day flagged for no hours.
If varSchedRecords(8, intK) = True Then
' Day flagged for no hours
CheckOutOfSchedule = True
intK = 0
Else
If curStartTime < varSchedRecords(9, intK) Or curStartTime >
varSchedRecords(10, intK) Or curStopTime < varSchedRecords(9, intK) Or
curStopTime > varSchedRecords(10, intK) Then
' times falls outside of scheduled time, go look for next one.
Else
' Have a record where were OK. Quit.
CheckOutOfSchedule = False
intK = 0
End If
End If
End If
End If
Next intK
If intFoundMatch = False Then CheckOutOfSchedule = False
End Function
-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com]On Behalf Of Julie
Reardon-Taylor
Sent: Thursday, June 19, 2003 11:09 AM
To: accessd at databaseadvisors.com
Subject: [AccessD] Calculating Time Cards
Hi Everyone,
<<snip>>