John,
My sincerest apologies for not replying sooner. I've been tied up with other
things, but here at last is my response. Please bear with me, as there a number
of controls / calculations used. This may be the problem, and these could be
reduced in number to speed things up. Perhaps you can let me know, and I will
bow to your superior knowledge / experience!
As I mentioned in my first post, the form contains two calculated fields, both
of which show a +/- figure depending on how many hours the employee has worked,
both in week and since the start of the year.
1. The weekly +/- text box has a Control Source as follows:
=IIf(sfmFullTimeSheet.Form!txtSumDuration-(37/24)<0,"-","") &
DiffTime(sfmFullTimeSheet.Form!txtSumDuration,37/24,4)
2. The cumulative +/- text box has a Control Source as follows:
=IIf(sfmFullTimeSheet.Form!txtHoursDifference<0,"-","") &
DiffTime(sfmFullTimeSheet.Form!txtActualHours,
sfmFullTimeSheet.Form!txtRealNumHours,4)
3. The control sfmFullTimeSheet.Form!txtSumDuration, is an unbound control, that
has its value set in the On Current event of the form, and the code is as
follows:
Private Sub Form_Current()
Dim datCRecDate As Date
Dim datWkStart As Date
Dim datWkEnd As Date
Dim datSumDur As Date
Dim rstClone As DAO.Recordset
If IsNull(Me.fldDateWorked) = False Then
' code assumes that a week runs from Monday through Sunday
datCRecDate = Me.fldDateWorked
datWkStart = DateAdd("d", 1 - DatePart("w", datCRecDate, vbMonday), _
datCRecDate)
datWkEnd = DateAdd("d", 6, datWkStart)
datSumDur = 0
Set rstClone = Me.RecordsetClone
rstClone.MoveFirst
Do While rstClone.EOF = False
If rstClone!fldDateWorked.Value >= datWkStart And _
rstClone!fldDateWorked.Value <= datWkEnd Then
If rstClone!fldIsWork.Value = True Then
If Not IsNull(rstClone!fldEndTime) And Not _
IsNull(rstClone!fldStartTime) Then
datSumDur = datSumDur + (rstClone!fldEndTime - _
rstClone!fldStartTime)
End If
End If
End If
rstClone.MoveNext
Loop
Me.txtSumDuration = datSumDur
Set rstClone = Nothing
End If
End Sub
4. The control sfmFullTimeSheet.Form!txtHoursDifference has a Control Source of:
=[txtActualHours]-[txtRealNumHours]
5. The control sfmFullTimeSheet.Form!txtActualHours has a Control Source of:
=Sum(IIf([tblProjects.fldProjectID]=400000,0,IIf([tblProjects.fldProjectID]= _
400006,0,IIf([tblProjects.fldProjectID]=400003,0.3083333333, _
[fldEndTime]-[fldStartTime])))) - [txtTotalOTHours]
6. The control sfmFullTimeSheet.Form!txtRealNumHours has a Control Source of:
=((DateDiff("ww","23-12-2002",Now())+1)*37)/24
7. The controls fldStartTime and fldEndTime, hold HH:MM values, in 24 hour
format
8. The DiffTime function, I picked up from a post in the NG, with the following
code:
'Author: © Copyright 2002 Pacific Database Pty Limited
' Graham R Seach (e-mail address removed)
' Phone: +61 2 9872 9594 Fax: +61 2 9872 9593
'
' You may freely use and distribute this code
' with any applications you may develop, on the
' condition that the copyright notice remains
' unchanged, and intact as part of the code. You
' may not sell or publish this code in any form
' without the express written permission of the
' copyright holder.
'
' Inputs: dteStart: The lower date.
' dteEnd: The upper date.
' iFormat: The enum value that specifies the
' output format. For example:
' dfHrFraction = fraction of an hour
' dfMinFraction = fraction of a minute
' dfH = Number of hours
' dfHM = Number of hours and minutes
' dfHMS = Number of hours, minutes and seconds
' vSeparator: User-defined separator used for dfH, dfHM,
' and dfHMS.
Public Enum DateFormat
dfHrFraction = 1
dfMinFraction = 2
dfH = 3
dfHM = 4
dfHMS = 5
End Enum
Public Function DiffTime(dteStart As Date, dteEnd As Date, iFormat As
DateFormat, Optional vSeparator As Variant = ":") As Variant
Dim iHr As Integer
Dim iMin As Integer
Dim iSec As Integer
Dim dteTemp As Date
Dim vTemp As Variant
Dim bSwapped As Boolean
DiffTime = Null
bSwapped = False
'Check that both dates are valid
If Not IsDate(dteStart) Or Not IsDate(dteEnd) Then
DoCmd.Beep
MsgBox "You must supply valid dates.", vbOKOnly + vbExclamation, _
"Invalid date"
Exit Function
End If
'Check that dteStart < dteEnd
If dteStart > dteEnd Then
'dteStart > dteEnd. Swap them
dteTemp = dteStart
dteStart = dteEnd
dteEnd = dteTemp
bSwapped = True
End If
'Calculate the time differences
iHr = Abs(DateDiff("h", dteStart, dteEnd)) - _
IIf(Format(dteStart, "nnss") <= Format(dteEnd, "nnss"), 0, 1)
dteStart = DateAdd("h", iHr, dteStart)
iMin = Abs(DateDiff("n", dteStart, dteEnd)) - _
IIf(Format(dteStart, "ss") <= Format(dteEnd, "ss"), 0, 1)
dteStart = DateAdd("n", iMin, dteStart)
iSec = Abs(DateDiff("s", dteStart, dteEnd))
'Setup the output format
Select Case iFormat
Case 1 'Return as a fraction of an hour
vTemp = iHr + (iMin / 60) + (iSec / 360)
Case 2 'Return as a fraction of a minute
vTemp = (iHr * 60) + iMin + (iSec / 60)
Case 3 'Return as Hour
vTemp = iHr
Case 4 'Return as Hour:Minute
vTemp = iHr & vSeparator & Format(iMin, "00")
Case 5 'Return as Hour:Minute:Second
vTemp = iHr & vSeparator & iMin & vSeparator & iSec
End Select
'Debug.Print iHr & ":" & iMin & ":" & iSec
'DiffTime = IIf(bSwapped, "-", "") & vTemp
DiffTime = vTemp
End Function
I hope you're still with me!!! I know it's a lot of code and controls, which I
think is the problem. However, I'm not sure on how to cut it down and
streamline the calculation.
Please help and advise.
Regards
Duncan
