Transformer un Stamp vers une date et vice versa

Commenter

Contenu du snippet 

Const DTS_START_YEAR = 1970
Const DTS_START_MNTH = 1
Const DTS_START_DAY = 1
Const DTS_STRAT_RBY = 2

'===============================\
'   RENVOI LE MARQUAGE ACTUEL    \
'=================================\
Public Function NowStamp() As Long
    NowStamp = DateToStamp(Now)
End Function

'===============================\
'  CONVERTI UN MARQUAGE EN DATE  \
'=================================\
Public Function StampToDate(ByVal Value As Long) As String
    Dim dys   As Integer
    Dim scs   As Integer
    Dim mns   As Integer
    Dim hrs   As Integer
    Dim d     As Integer
    Dim m     As Integer
    Dim b     As Integer
    Dim n     As Integer
    Dim Y     As Integer
    Dim mxd() As Byte
    '--------------------------
    ReDim mxd(1 To 12)
    '--------------------------
    mxd(1) = 31
    mxd(2) = 28
    mxd(3) = 31
    mxd(4) = 30
    mxd(5) = 31
    mxd(6) = 30
    mxd(7) = 31
    mxd(8) = 31
    mxd(9) = 30
    mxd(10) = 31
    mxd(11) = 30
    mxd(12) = 31
    '--------------------------
    scs = (Value Mod 60)
    mns = (Value \ 60) Mod 60
    hrs = (Value \ 3600) Mod 24
    dys = (Value \ 86400)
    '--------------------------
    b = DTS_STRAT_RBY
    d = DTS_START_DAY
    m = DTS_START_MNTH
    Y = DTS_START_YEAR
    While dys > 0
        d = d + 1
        n = mxd(m)
        dys = dys - 1
        If (b = 0) And (m = 2) Then n = (n + 1)
        If (d > n) Then
            d = 1
            m = m + 1
            If (m > 12) Then
                m = 1
                b = b - 1
                Y = Y + 1
                If (b < 0) Then b = 3
            End If
        End If
    Wend
    '--------------------------
    StampToDate = DateSerial(Y, m, d) & " " & TimeSerial(hrs, mns, scs)
    '--------------------------
End Function

'================================\
'  CONVERTI UNE DATE EN MARQUAGE  \
'==================================\
Public Function DateToStamp(ByVal Value As Date) As Long
    Dim scs   As Integer
    Dim mns   As Integer
    Dim hrs   As Integer
    Dim dow   As Integer
    Dim yrs   As Integer
    Dim mth   As Integer
    Dim dys   As Integer
    Dim d     As Integer
    Dim m     As Integer
    Dim b     As Integer
    Dim n     As Integer
    Dim Y     As Integer
    Dim mxd() As Byte
    '--------------------------
    ReDim mxd(1 To 12)
    '--------------------------
    mxd(1) = 31
    mxd(2) = 28
    mxd(3) = 31
    mxd(4) = 30
    mxd(5) = 31
    mxd(6) = 30
    mxd(7) = 31
    mxd(8) = 31
    mxd(9) = 30
    mxd(10) = 31
    mxd(11) = 30
    mxd(12) = 31
    '--------------------------
    scs = Second(Value)
    mns = Minute(Value)
    hrs = Hour(Value)
    dow = Day(Value)
    mth = Month(Value)
    yrs = Year(Value)
    If yrs <= 1969 Then Err.Raise 380
    If yrs >= 2040 Then Err.Raise 380
    '--------------------------
    b = DTS_STRAT_RBY
    d = DTS_START_DAY
    m = DTS_START_MNTH
    Y = DTS_START_YEAR
    Do
        If (Y = yrs) And (m = mth) And (d = dow) Then Exit Do
        d = d + 1
        n = mxd(m)
        dys = dys + 1
        If (b = 0) And (m = 2) Then n = (n + 1)
        If (d > n) Then
            d = 1
            m = m + 1
            If (m > 12) Then
                m = 1
                b = b - 1
                Y = Y + 1
                If (b < 0) Then b = 3
            End If
        End If
    Loop
    '--------------------------
    DateToStamp = scs + (mns * 60&) + (hrs * 3600&) + (dys * 86400)
    '--------------------------
End Function

Compatibilité : VB6, VBA

Disponible dans d'autres langages :

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_EBArtSoft)