1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53
| Public Function JourSemaine(LaDate As String)
Dim M As Byte
Dim D As Byte
Dim Y As Long
Dim J As Long
D = Split(LaDate, "/")(0) ' merci ouskel'n'or
M = Split(LaDate, "/")(1)
Y = Split(LaDate, "/")(2)
If CSng(Y & "." & M & D) < 1582.1015 Then Exit Function ' Ne prend pas les Dates Julienne
If (D < 1 Or D > 31) Or (M < 1 Or M > 12) Then Exit Function ' Test sur jours et mois
If D = 29 And M = 2 Then ' Test années bissextiles
If Y Mod 400 = 0 Or (Y Mod 4 = 0 And Y Mod 100 <> 0) Then
GoTo Suite
Else
Exit Function
End If
End If
Suite:
' Je ne sais plus ou j'avais récupérer la formule qui suit, Sans doute dans le livre Le Calendrier de Paul Couderc,
' que je n'ais plus et qui ne semble plus disponible aujourd'hui.
If M > 2 Then
M = M + 1
Y = Y
Else
M = M + 13
Y = Y - 1
End If
J = Int(365.25 * Y) - Int(Y / 100) + Int(Y / 400) + Int(30.6001 * M) + D - 478164
Select Case (J Mod 7) + 1
Case 1
JourSemaine = "dimanche"
Case 2
JourSemaine = "lundi"
Case 3
JourSemaine = "mardi"
Case 4
JourSemaine = "mercredi"
Case 5
JourSemaine = "jeudi"
Case 6
JourSemaine = "vendredi"
Case 7
JourSemaine = "samedi"
End Select
End Function |
Partager