Soyez le premier à donner votre avis sur cette source.
Snippet vu 39 654 fois - Téléchargée 39 fois
Option Explicit Private Function JJ(Dates As Date) Dim y As Long, m As Long, DDdd As Double Dim YYYY As Long, MM As Long Dim a As Double, b As Double YYYY = Year(Dates) MM = Month(Dates) DDdd = Day(Dates) + Hour(Dates) / 24 + Minute(Dates) / 24 / 60 + Second(Dates) / 24 / 60 / 60 If MM <= 2 Then y = YYYY - 1: m = MM + 12 Else y = YYYY: m = MM If Dates >= 1582.1015 Then a = y \ 100 b = 2 - a + a \ 4 End If If y = Abs(y) Then JJ = Int(365.25 * y) + Int(30.6001 * (m + 1)) + DDdd + 1720994.5 + b Else JJ = Int(365.25 * y) + Int(30.6001 * (m + 1)) + DDdd + 1720994.5 End If End Function Private Function JourSemaine(Dat As Date) As Long Dim a As Double a = JJ(Dat) + 1.5 a = a Mod 7 JourSemaine = a End Function Private Function JourAnnée(Dat As Date) As Integer Dim I As Integer I = Year(Dat) If (I Mod 400 = 0) Or ((I Mod 100 <> 0) And (I Mod 4 = 0)) Then JourAnnée = Int((275 * Month(Dat)) / 9) - Int((Month(Dat) + 9) / 12) + Day(Dat) - 30 Else JourAnnée = Int((275 * Month(Dat)) / 9) - (2 * Int((Month(Dat) + 9) / 12)) + Day(Dat) - 30 End If End Function Public Function NumeroSemaine(Dates As Date) As Byte Dim NbJour1ereSemaine As Byte, JourJulienDates As Double, JourJulien1Janvier Dim JourSemaine1Janvier As Byte, JourAnneeDates As Integer JourJulienDates = JJ(Dates) JourJulien1Janvier = JJ(DateSerial(Year(Dates), 1, 1)) JourSemaine1Janvier = JourSemaine(DateSerial(Year(Dates), 1, 1) + TimeSerial(0, 0, 0)) If JourSemaine1Janvier = 0 Then NbJour1ereSemaine = 1 Else NbJour1ereSemaine = -(JourSemaine1Janvier - 8) End If NumeroSemaine = Int((JourAnnée(Dates) - 1 - NbJour1ereSemaine) / 7) + 2 If NumeroSemaine > 52 Then NumeroSemaine = NumeroSemaine - 52 End Function
Function WOY (MyDate As Date) As Integer ' Week Of Year
WOY = Format(MyDate, "ww", vbMonday, vbFirstFourDays)
If WOY > 52 Then If Format(MyDate + 7, "ww", vbMonday, vbFirstFourDays) 2 Then WOY 1
End If
End Function
Utilisation:
Mon_numéro_de_semaine = WOY(ma_date)
A+++
lundi 29/12/2003 et lundi 31/12/2007 (renvoit semaine 53 au lieu de semaine 1)
C'était séduisant, mais...
1 - l'argument pour la semaine est "ww"
2 - il faut utiliser les arguments "firstdayofweek" et "Firstweekofyear"
ce qui donnerait :
DateDiff("ww",DateSerial(Year(Date),1,1),Date,2,2)
Mais malgré ça je n'obtiens jamais la bonne semaine.
pour aujourd'hui, 11/05/2009, j'obtiens la semaine 19 alors que nous sommes en semaine 20 !
msgbox DateDiff("w",DateSerial(Year(Date),1,1),Date)
Merci d'avoir joué !
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.