All pastes #492621 Raw Edit

Miscellany

public text v1 · immutable
·published 2007-05-17 09:53 UTC
rendered paste body
Public Function CalculateNonWorkHours(Start As Date, Finish As Date) As Double
  Dim StartDay As Double, StartTime As Double
  Dim FinishDay As Double, FinishTime As Double
  Dim Ret As Double, DayOfWeek As Byte 
  
  If Finish < Start Then
    Dim Tmp As Date
    Tmp = Start
    Start = Finish
    Finish = Tmp
  End If
  
  StartDay = Int(Start)
  StartTime = Round((Start - StartDay) * HoursPerDay, 4) 
  FinishDay = Int(Finish)
  FinishTime = Round((Finish - FinishDay) * HoursPerDay, 4)
  
  Ret = 0
  
  If StartDay = FinishDay Then
    Ret = Ret + HoursOutsideWorkHours(Weekday(StartDay), StartTime, FinishTime) 
  Else
    Dim Day As Date, ThisDayStart As Double, ThisDayFinish As Double
    
    For Day = StartDay To FinishDay
      If Day = StartDay Then
        ThisDayStart = StartTime
        ThisDayFinish = HoursPerDay 
      ElseIf Day = FinishDay Then
        ThisDayStart = 0
        ThisDayFinish = FinishTime
      Else
        ThisDayStart = 0
        ThisDayFinish = HoursPerDay
      End If
      
      Ret = Ret + HoursOutsideWorkHours(Weekday(Day), ThisDayStart, ThisDayFinish) 
    Next
  End If
  
  CalculateNonWorkHours = Ret
End Function

Private Function HoursOutsideWorkHours(Weekday As VbDayOfWeek, Start As Double, Finish As Double) As Double
  Dim Ret As Double
  Ret = 0
  
  Select Case Weekday
    Case vbSunday, vbSaturday ' or national public holiday... 
      Ret = Ret + (Finish - Start)
    Case Else
      If Start < WorkDayStart Then
        Ret = Ret + (WorkDayStart - Start)
      End If
      
      If Finish > WorkDayFinish Then
        Ret = Ret + (Finish - WorkDayFinish) 
      End If
  End Select
  
  HoursOutsideWorkHours = Ret
End Function