- 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
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