3 petites fonctions sur des dates
Soyez le premier à donner votre avis sur cette source.
Snippet vu 5 504 fois - Téléchargée 29 fois
Contenu du snippet
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
Si vous avez tout suivi
Devinez ce que l'on obtient si l'on écrit :
Debug.Print UnPack(Pack("21/11/2003"))
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"))
A voir également
- 3 petites fonctions sur des dates
- 3 petites fonctions dom pour les navigateurs qui ne les prennent pas - Codes sources - Javascript (Divers)
- 3 petites fonctions pour gerer vos frame frames - Codes sources - Javascript (Effets)
- Petites fonctions pour utiliser les dates - Codes sources - ASP / ASP.NET (Date/Heure)
- Afficher 3 listes déroulantes en fonction de la date du jour - Codes sources - ASP / ASP.NET (Date/Heure)
- Age en fonction de la date de naissance ✓ - Forum - SQL
Commentaire
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.