DominoArea.org [Archive]

Const StartHDay = 9
Const EndHDay = 18
Const WorkDaySecond = (EndHDay -StartHDay) * 60 * 60
Const DayInSecond = 86400
Const HeuresOuvres = False

Function WorkHours( fDate As notesdatetime, sDate As notesdatetime) As String
Dim LocalCount As Double
Dim CountDays, CountSeconds As Long
Dim fsInDate, fmInDate, fhInDate,ssInDate, smInDate, shInDate As Integer
Dim days As Long
Dim reste As Long
'// faire la différence en heures ouvrées entre deux dates

'// if 00:00:00 -> StartHDay -> StartHDay
'// if EndHDay -> 23:59:59 -> EndHDay
'// if saturday or sunday -> vendredi 18:00:00
Set fDate = WorkAdjustDay(fDate)
Set sDate = WorkAdjustDay(sDate)
Set fDate = WorkAdjustHour(fDate)
Set sDate = WorkAdjustHour(sDate)

'From fDate To sDate
If sDate.TimeDifference(fDate) <= 0 Then
WorkHours = "00:00:00"
Exit Function
End If
If Datevalue(fdate.DateOnly) = Datevalue(sdate.DateOnly) Then
WorkHours = GetExcelTime(sDate.TimeDifference(fDate))
Exit Function
End If

While Not sDate.TimeDifference(fDate) < DayInSecond

Call fDate.AdjustDay(1)

Select Case Weekday(fDate.DateOnly)
Case 1
Case 7
Case Else
'// si le jour est <> ajouter 1 sinon 0
If Not Datevalue(sDate.DateOnly) = Datevalue(fDate.DateOnly) Then
CountDays = CountDays +1
End If
End Select

Wend

fsInDate = Second (fDate.TimeOnly)
fmInDate= Minute (fDate.TimeOnly)
fhInDate= Hour(fDate.TimeOnly)
ssInDate=Second(sDate.TimeOnly)
smInDate = Minute(sDate.TimeOnly)
shInDate = Hour (sDate.TimeOnly)
If CountDays = 0 & fDate.DateOnly = sDate.DateOnly Then
CountSeconds = ((shInDate - fhInDate) * 3600) + ((smInDate - fmInDate)*60) + (ssInDate - fsInDate)
Else
CountSeconds = ((EndHDay -fhInDate)* 3600 ) - (fmInDate * 60) - fsInDate
CountSeconds = CountSeconds + ((shInDate - StartHDay) * 3600) + (smInDate *60) + ssInDate
End If

'// Two choices : if HeuresOuvres = true 24 Hours = 24 Hours Work
'// else EndHDay - StartHDay = 1 Day Work

If HeuresOuvres Then
WorkHours = GetExcelTime( ((CountDays) * WorkDaySecond) + CountSeconds)
Else
reste = (((CountDays) * WorkDaySecond) + CountSeconds) Mod WorkDaySecond
days = Int ((((CountDays) * WorkDaySecond) + CountSeconds) / DayInSecond) * DayInSecond
WorkHours =GetExcelTime (days + reste)
End If

End Function

Function WorkAdjustHour(InDate As notesdatetime) As notesdatetime
Dim sInDate, mInDate, hInDate As Integer
Select Case Hour(inDate.TimeOnly)
Case Is < StartHDay
sInDate = Second(inDate.TimeOnly)
mInDate = Minute(inDate.TimeOnly)
hInDate = Hour(inDate.TimeOnly)
Call InDate.AdjustSecond(-sInDate)
Call InDate.Adjustminute(-mInDate)
Call InDate.AdjustHour(-HInDate + StartHDay )
Case Is >= EndHDay
sInDate = Second(inDate.TimeOnly)
mInDate = Minute(inDate.TimeOnly)
hInDate = Hour(inDate.TimeOnly)
Call InDate.AdjustSecond(-sInDate)
Call InDate.Adjustminute(-mInDate)
Call InDate.AdjustHour(-HInDate + EndHDay )
End Select
Set WorkAdjustHour= InDate
End Function

Function WorkAdjustDay(InDate As notesdatetime) As notesdatetime
Dim sInDate, mInDate, hInDate As Integer
Select Case Weekday(InDate.DateOnly)
Case 1'Sunday
'if Sunday -> Friday EndHDay heures
Call InDate.AdjustDay(-2)
sInDate = Second(inDate.TimeOnly)
mInDate = Minute(inDate.TimeOnly)
hInDate = Hour(inDate.TimeOnly)
Call InDate.AdjustSecond(-sInDate)
Call InDate.Adjustminute(-mInDate)
Call InDate.AdjustHour(-HInDate + EndHDay )
Case 2 'Monday if before StartHDay Friday EndHDay
Select Case Hour(inDate.TimeOnly)
Case Is < StartHDay
Call InDate.AdjustDay(-3)
sInDate = Second(inDate.TimeOnly)
mInDate = Minute(inDate.TimeOnly)
hInDate = Hour(inDate.TimeOnly)
Call InDate.AdjustSecond(-sInDate)
Call InDate.Adjustminute(-mInDate)
Call InDate.AdjustHour(-HInDate + EndHDay )
End Select
Case 6 'Friday if after EndHDay -> Friday EndHDay
Select Case Hour(inDate.TimeOnly)
Case Is > EndHDay
sInDate = Second(inDate.TimeOnly)
mInDate = Minute(inDate.TimeOnly)
hInDate = Hour(inDate.TimeOnly)
Call InDate.AdjustSecond(-sInDate)
Call InDate.Adjustminute(-mInDate)
Call InDate.AdjustHour(-HInDate + EndHDay )
End Select
Case 7 Saturday
'if Saturday -> Friday EndHDay
Call InDate.AdjustDay(-1)
sInDate = Second(inDate.TimeOnly)
mInDate = Minute(inDate.TimeOnly)
hInDate = Hour(inDate.TimeOnly)
Call InDate.AdjustSecond(-sInDate)
Call InDate.Adjustminute(-mInDate)
Call InDate.AdjustHour(-HInDate + EndHDay )
End Select
Set WorkAdjustDay = InDate
End Function

Function GetExcelTime( TotalSeconds As Long) As String
'// renvoyer au format hh:mm:ss le TotalSeconds
Dim strHeures, strMinutes, strSeconds As String
Dim TotalMinutes, TotalHeures As Long

strSeconds = Trim$(TotalSeconds Mod 60)
TotalMinutes = (TotalSeconds - ( TotalSeconds Mod 60)) / 60
strMinutes = Trim$( TotalMinutes Mod 60)
TotalHeures = (TotalMinutes - (TotalMinutes Mod 60)) / 60
strHeures = Trim$(TotalHeures)
GetExcelTime = strHeures & ":" & strMinutes & ":" & strSeconds
End Function