Si vous jugez le format date trop long = 10 octets avec cela vous le ramenerez à 3 octets
Configurer windows avec les propriétés pays en francais métropole !
Les trois petites fonctions sont les suivantes :
1/ DateByWeekAndDOW(ByVal Dow As Integer, _
ByVal Week As Integer, _
ByVal Year As Integer) As Date
==> Retourne une date en connaissant le Ième jour dans la semaine pour une année donnée ex : DateByWeekAndDOW(5,47,2003) retourne 21/11/2003
Dow = Day Of Week 1=Lundi, 2=Mardi,...5=Vendredi
2/ Pack(ByVal JJMMAAAA As Date) As String
==> Retourne une chaine codée en base 256 représentant la date passée avec l'argument JJMMAAAA de type date
3/ UnPack(ByVal PackedDate As String) As Date
==> L'inverse de la fonction Pack décrite ci-dessus
Source / Exemple :
Public Function DateByWeekAndDOW(ByVal Dow As Integer, _
ByVal Week As Integer, _
ByVal Year As Integer) As Date
Dim d As Date
If Week > 0 And Week <= Format("31/12/" & Year, "ww", vbUseSystemDayOfWeek, vbUseSystem) And Dow > 0 And Dow < 8 Then
d = DateAdd("d", 7 * (Week - 1), "01/01/" & Year)
DateByWeekAndDOW = DateAdd("d", -Weekday(d, vbUseSystemDayOfWeek), d) + Dow
End If
End Function
'----------------------------------------------------------------------------------------------
Public Function Pack(ByVal JJMMAAAA As Date) As String
Dim FirstPack As Long
Dim Result As String
FirstPack = Weekday(JJMMAAAA, vbUseSystemDayOfWeek) & Format(Format(JJMMAAAA, "ww", vbUseSystemDayOfWeek, vbUseSystem), "00") & Year(JJMMAAAA)
Do While FirstPack > 256
Result = Result & Chr(FirstPack Mod 256)
FirstPack = Int(FirstPack / 256)
Loop
Pack = Result & Chr(FirstPack)
End Function
'----------------------------------------------------------------------------------------------
Public Function UnPack(ByVal PackedDate As String) As Date
Dim I As Integer
Dim FirstPack As Long
For I = 1 To Len(PackedDate)
FirstPack = FirstPack + Asc(Mid(PackedDate, I, 1)) * 256 ^ (I - 1)
Next I
UnPack = DateByWeekAndDOW(Left(FirstPack, 1), Mid(FirstPack, 2, 2), Right(FirstPack, 4))
End Function
Conclusion :
Si vous avez tout suivi
Devinez ce que l'on obtient si l'on écrit :
Debug.Print UnPack(Pack("21/11/2003"))
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.