' FirstDayOfCurrentWeek
' http://www.utteraccess.com/wiki/index.php/FirstDayOfCurrentWeek
' Code courtesy of UtterAccess Wiki
' Licensed under Creative Commons License
' http://creativecommons.org/licenses/by-sa/3.0/
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
'
' rev  date                          brief descripton
' 1.1  2011-02-19                    else clause modified
'
Public Function fFirstDayOfCurrentWeek(rbytWeekStartsOn As Byte) As Date
' Procedure: fFirstDayOfCurrentWeek
'
' Description:return the date of the first day of the week in which
'              the current day occurs
'--
   Const cstrProcedure = "fFirstDayOfCurrentWeek"

   Dim intOffset As Integer
   Dim dtmResult As Date

   On Error GoTo HandleError

   intOffset = Weekday(Date) - rbytWeekStartsOn

   If intOffset >= 0 Then
       dtmResult = Date - intOffset
   Else
       'dtmResult = rDate + 7 - intOffset
      dtmResult = Date - intOffset - 7
   End If

   fFirstDayOfCurrentWeek = dtmResult

HandleExit:

   Exit Function

HandleError:
   'insert custom error handler here
'    ErrorHandle Err, Erl(), cstrModule & "." & cstrProcedure
'    Resume HandleExit
End Function