3 petites fonctions sur des dates

Soyez le premier à donner votre avis sur cette source.

Snippet vu 5 482 fois - Téléchargée 29 fois

Commenter

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

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

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 (philoo91)