Numéro de la semain au format ISO (Norme 8601)

[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