Code Domain

'.fwrkLSDate:

Option Public
Option Explicit



Function GetCalendarWeek( Byval inputdate As Variant ) As String
       
%REM

This function calculates the calendar week number
(ISO standard) for a given date value. The format
function of LotusScript (parameter "ww") does not solve
this problem.

Monday is the first day of the week. Week #1 is the week
that contains the 4th of January (ISO 8601). The week at the
end/beginning of the year belongs to the next/previous year,
if there are 3 days or less of that week in the year in question.

Christian Meis, 4.2.2000
%END REM
       
       Dim InputDateOffset As Integer
       Dim YearInQuestion As Integer
       Dim January4 As Variant
       Dim January4Offset As Integer
       Dim FirstMondayOfYear As Variant
       Dim January1Offset As Integer
       Dim December31Offset As Integer
       Dim weeknum As Integer
       
 ' The year value is preset with that of the input date
       YearInQuestion = Year( inputdate )
       
 ' Calculate offset to monday from the input date
       InputDateOffset = CalculateIsoWeekday( inputdate )
       
 ' Calculate offsets for the first/last day of the year
       January1Offset = CalculateIsoWeekday( Cdat( "01.01." & Cstr( YearInQuestion ) ) )
       December31Offset = CalculateIsoWeekday( Cdat( "31.12." & Cstr( YearInQuestion  ) ) )
       
 ' If the input date is before the 4th of January and the year starts with
 ' a friday, saturday or sunday, the week belongs to the previous year
 ' if the entered date is not a monday or tuesday
       If Month( inputdate ) = 1 And Day( inputdate ) < 4 And January1Offset> 3 And InputDateOffset > 1 Then
               YearInQuestion = YearInQuestion - 1
       End If
       
 ' If the input date is after the 28th of December and the year ends with
 ' a monday, tuesday or wednesday, then the week belongs to the following year
 ' if the entered date is not a saturday or sunday
       If Month( inputdate ) = 12 And Day( inputdate ) > 28 And December31Offset < 3 And InputDateOffset < 5 Then
               YearInQuestion = YearInQuestion + 1
       End If
       
 ' The 4th of January defines week #1
       January4 = Cdat( "04.01." & Cstr( YearInQuestion ) )
       
 ' Offset to the monday of week #1
       FirstMondayOfYear = Cdat( January4 - CalculateIsoWeekday( January4 ) )
       
 ' The time range between the monday of week #1 and the monday
 ' of the week in question is divided by 7, plus 1 for the first week
       weeknum = ( inputdate - InputDateOffset - FirstMondayOfYear ) \ 7 + 1
       
 ' The return value is a string with the week number and the year
       GetCalendarWeek = Cstr( YearInQuestion ) & "/" & Right("0" + Cstr( weeknum ),2)
       
End Function
Function CalculateIsoWeekday( tmpdate As Variant ) As Integer
       
%REM

This function converts the weekday-numbers from the
standard function to an offset acc. to the ISO version
monday -> 0, ... , sunday -> 6
%END REM
       
       Dim n As Integer
       
       n = Weekday( tmpdate )
       
       If n = 1 Then ' sunday to end of week
               n = n + 7
       End If
       
       CalculateIsoWeekday = n - 2
       
End Function

Gruß JJR

P.S.: Werde, unter der Bedingung des Nicht-Vergessens, diese in das nächste Release von ODA einbinden.