Page 1 sur 1
Numéro de la semain au format ISO (Norme 8601)
Publié:
07 Sep 2005 à 14:46par beepbeep
- Code : Tout sélectionner
Function GetIsoWeekNumber (GivenDate As NotesDateTime) As Integer
'Paramètre GivenDate : Il faut passer en paramètre un NotesDateTime qui a été
'instanciée de la façon suivante NotesDateTime.LocalTime = jj/mm/aaaa.
'Si ce n'est pas fait de cette façon, il risque d'y avoir des erreurs de fuseau.
'* Norme ISO-8601:
'* - La semaine 1 de toute année est celle qui contient le 4 janvier ou que la
' semaine 1 de toute année est celle qui contient le 1er jeudi de janvier.
'* - La majorité des années ont 52 semaines mais les années qui commence un
' jeudi et les années bissextiles commençant un mercredi en possède 53.
'* - Le 1er jour de la semaine est le Lundi
Dim FirstOfYear As New NotesDateTime ("") '1er Janvier de l'année de la date passée en paramètre
Dim LastOfYear As New NotesDateTime ("") '31 décembre de l'année de la date passée en parmètre
Dim FirstDayNum As Integer 'Numéro du jour du 1er Janvier de l'année de la date passée en paramètre
Dim LastDayNum As Integer 'Numéro du jour du 31 décembre de l'année de la date passée en paramètre
Dim ISO_FirstDayNum As Integer 'Numero du jour ISO pour le 1er Janvier
Dim ISO_LastDayNum As Integer 'Numero du jour ISO pour le 31 Décembre
Dim IsFirstWeek As Integer 'Booléen - première semaine de l'année
Dim IsLastWeek As Integer 'Booléen - dernière semaine de l'année
Dim ISO_FirstDay As New NotesDateTime ("") 'Date du premier jour de la remière semaine ISO
Dim ISO_LastDay As New NotesDateTime ("") 'Date du dernier jour de la dernière semaine ISO
Dim LastWeekLastYear As Double '
Dim AdjustLastWeek As Double '
Dim NumWeeks As Double '
Dim WeekAdjust As Double '
Dim DateTemp As New NotesDateTime ("") 'Date temporaire servant aux calculs
Dim DateTemp2 As New NotesDateTime ("") 'Date temporaire servant aux calculs
DateTemp2.LocalTime = Datenumber (2005, 09, 05)
'DateTemp2.LSLocalTime = Datenumber (Year(GivenDate.LSLocalTime), Month(GivenDate.LSLocalTime), Day(GivenDate.LSLocalTime))
'==
FirstOfYear.LocalTime = Datenumber ( Year(GivenDate.LocalTime) , 01 , 01 )
LastOfYear.LocalTime = Datenumber ( Year(GivenDate.LocalTime) , 12 , 31 )
FirstDayNum = Weekday(FirstOfYear.LocalTime)
LastDayNum = Weekday(LastOfYear.LocalTime)
'== Les semaines ISO commencent le Lundi et finissent le Dimanche
'== donc on corrige les valeurs retournées par Notes
If FirstDayNum = 1 Then
ISO_FirstDayNum = 7
Else
ISO_FirstDayNum = FirstDayNum - 1
End If
If LastDayNum = 1 Then
ISO_LastDayNum = 7
Else
ISO_LastDayNum = LastDayNum - 1
End If
If (7 - ISO_FirstDayNum) > 2 Then
IsFirstWeek = True
Else
IsFirstWeek = False
End If
If (7 - ISO_LastDayNum) < 4 Then
IsLastWeek = True
Else
IsLastWeek = False
End If
'Date du premier jour de la première semaine ISO
ISO_FirstDay.LocalTime = Datenumber ( Year(FirstOfYear.LocalTime) , Month(FirstOfYear.LocalTime) , Day(FirstOfYear.LocalTime) )
If IsFirstWeek Then
Call ISO_FirstDay.AdjustDay( 1 - ISO_FirstDayNum )
Else
Call ISO_FirstDay.AdjustDay( 8 - ISO_FirstDayNum )
End If
'Date du dernier jour de la dernière semaine ISO
ISO_LastDay.LocalTime = Datenumber ( Year(LastOfYear.LocalTime) , Month(LastOfYear.LocalTime) , Day(LastOfYear.LocalTime) )
If IsLastWeek Then
Call ISO_LastDay.AdjustDay ( 7 - ISO_LastDayNum )
Else
Call ISO_LastDay.AdjustDay ( -ISO_LastDayNum )
End If
If GivenDate.TimeDifferenceDouble(ISO_LastDay) > 0 Then
GetIsoWeekNumber = 01
Exit Function
End If
DateTemp.LocalTime = Datenumber ( Year(FirstOfYear.LocalTime) , Month(FirstOfYear.LocalTime) , Day(FirstOfYear.LocalTime) )
Call DateTemp.AdjustYear(-1)
LastWeekLastYear = GivenDate.TimedifferenceDouble(DateTemp)/60/60/24/7
AdjustLastWeek = 1 - ( LastWeekLastYear - Int ( LastWeekLastYear ) )
LastWeekLastYear = LastWeekLastYear + AdjustLastWeek
If GivenDate.TimeDifferenceDouble(ISO_FirstDay) < 0 Then
Msgbox "Sortie Semaine " & Cstr(LastWeekLastYear)
GetIsoWeekNumber = Cint(LastWeekLastYear)
Exit Function
End If
NumWeeks = GivenDate.TimedifferenceDouble(ISO_FirstDay)/60/60/24/7
WeekAdjust = 1 - ( NumWeeks - Int ( NumWeeks ) )
Dim ISO_WeekNum As Double
ISO_WeekNum = NumWeeks + WeekAdjust
GetIsoWeekNumber = ISO_WeekNum
End Function