Soyez le premier à donner votre avis sur cette source.
Snippet vu 5 669 fois - Téléchargée 31 fois
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
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.