--- Soumis par Michel Walsh et Terry Kreft---

Changements d'heure (printemps/automne) et calcul de différence de temps.

    On peut retrouver l'information des changement d'heure (printemps/automne) à l'aide de fonctions de l'API qui explorent le Registre du système. Comme bénéfices additionnels, on peut alors calculer précisément une différence en secondes ou en minutes entre deux dates_heures qui peuvent traverser un tel changement, une amélioration sur DateDiff.

'************************** Code Start ***********************
'This code was originally written by Terry Kreft & Michel Walsh
'It is not to be altered or distributed, 
'except as part of an application. 
'You are free to use it in any application,  
'provided the copyright notice is left unchanged.

'Ce code fut originalement écrit par Terry Kreft & Michel Walsh
'Il ne doit être ni altéré, ni distribué
'sauf comme partie intégrée à une application.
'Vous êtes libre d'utiliser ce code 
'à la condition de laisser cette note, sans modification.

'Code courtesy of 
'Terry Kreft & Michel Walsh
'
Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type

Type TIME_ZONE_INFORMATION
  Bias As Long
  StandardName(31) As Integer
  StandardDate As SYSTEMTIME
  StandardBias As Long
  DaylightName(31) As Integer
  DaylightDate As SYSTEMTIME
  DaylightBias As Long
End Type

Declare Function GetTimeZoneInformation Lib "kernel32" _
  (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

Function PreciseDateDiff(Interval As String, ByVal Date1, ByVal Date2, _
                        Optional FirstDayOfWeek As Integer = vbSunday, _
                        Optional FirstWeekOfYear As Integer = vbFirstJan1) _
                        As Long
'D'une suggestion originale de  Michel Walsh
'Obtenir DateDiff, qui tient compte des changement d'heure
'
' Exemple d'utilisation:
'
'   ? PreciseDateDiff("h", #1/1/90#, #5/5/98#)
'
  Dim lngRet As Long
  Dim TZI As TIME_ZONE_INFORMATION
  Dim strEval As String
  If Eval("'" & Interval & "' in ('h','n','s')") Then
    If FirstDayOfWeek >= 0 And FirstDayOfWeek <= 7 Then
      If FirstWeekOfYear >= 0 And FirstWeekOfYear <= 3 Then
        lngRet = GetTimeZoneInformation(TZI)
        strEval = DateForSQL(Date1) & " between " _
                & DateForSQL(SummerTime(Year(Date1))) & " and " _
                & DateForSQL(StandardTime(Year(Date1)))
        If Eval(strEval) Then
          Date1 = DateAdd("n", TZI.DaylightBias, Date1)
        End If
        strEval = DateForSQL(Date2) & " between " _
                & DateForSQL(SummerTime(Year(Date2))) & " and " _
                & DateForSQL(StandardTime(Year(Date2)))
        If Eval(strEval) Then
          Date2 = DateAdd("n", TZI.DaylightBias, Date2)
        End If
        lngRet = DateDiff(Interval, Date1, Date2, _
                                    FirstDayOfWeek, FirstWeekOfYear)
        PreciseDateDiff = lngRet
      End If
    End If
  Else
    PreciseDateDiff = DateDiff(Interval, Date1, Date2, FirstDayOfWeek, FirstWeekOfYear)
  End If
End Function

Private Function DateForSQL(dteDate) As String
  DateForSQL = Format(dteDate, "\#m/dd/yyyy h:nn:ss AM/PM \#")
End Function


Public Function SummerTime(Optional intYear As Long = -1) As Date
    ' Originalement soumis par Terry Kreft
    '   modifié pour accepté une année (optionnel)

    If -1 = intYear Then intYear = Year(Date)
    ' Cette année-ci, par défaut, non -1
    
    Dim lngRet As Long
    Dim TZI As TIME_ZONE_INFORMATION
    lngRet = GetTimeZoneInformation(TZI)
    With TZI.DaylightDate
        SummerTime = CVDate(GetSundate(.wMonth, .wDay, _
                                    intYear) + (.wHour / 24))
    End With
End Function

Public Function StandardTime(Optional intYear As Long = -1) As Date
    ' Originalement soumis par Terry Kreft
    '   modifié pour accepté une année (optionnel)

    If -1 = intYear Then intYear = Year(Date)
    ' Cette année-ci, par défaut, non -1
    
    Dim lngRet As Long
    Dim TZI As TIME_ZONE_INFORMATION
    lngRet = GetTimeZoneInformation(TZI)
    With TZI.StandardDate
        StandardTime = CVDate(GetSundate(.wMonth, .wDay, _
                                    intYear) + (.wHour / 24))
    End With
End Function

Private Function GetSundate(intMonth As Integer, _
                            intSun As Integer, _
                            Optional intYear As Long = -1) _
                            As Date
    ' Originalement soumis par Terry Kreft
    '   modifié pour accepté une année (optionnel)

    If intYear = -1 Then intYear = Year(Date)
    ' si non fourni, prendre cette année-ci
    
    Dim varRet As Variant
    Dim intDayOfWeek As Integer
    
    varRet = DateSerial(intYear, intMonth, 1)
    ' éviter les problèmes d'options régionales
    
    intDayOfWeek = WeekDay(varRet)
    If intDayOfWeek <> 1 Then
        varRet = DateAdd("d", 8 - intDayOfWeek, varRet)
    End If
    varRet = DateAdd("ww", intSun - 1, varRet)
    GetSundate = varRet
End Function
'************************** Code End ***********************