Une petite fonction qui indique si un jour est férié ou pas. Si c'est férié la fonction renvoie le nom du jour férié. Autrement, une chaine vide.
Ex : If len(fjourferie("25/11/2002") = 0 then toto ou ...
lblMsgFerie.caption = fjourferie("25/11/2002")
Merci de m'indiquer si c'est fiable ou pas !!
Source / Exemple :
Option Explicit
'--------------
'si pas jour férié = chaine vide
'autrement --> nom du jour férié
'-------------------------------
Public Function fJourFerie(ByVal dtDate As Date) As String
Dim A As Integer, M As Integer, D As Integer
Dim tmpDate As Date
A = Year(dtDate): M = Month(dtDate): D = Day(dtDate)
If M = 1 And D = 1 Then
fJourFerie = "1er Janvier - Jour de l'Ans"
Exit Function
ElseIf M = 5 And D = 1 Then
fJourFerie = "1er Mai - Fête du Travail"
Exit Function
ElseIf M = 5 And D = 8 Then
fJourFerie = "8 Mai - Victoire 1945"
Exit Function
ElseIf M = 7 And D = 14 Then
fJourFerie = "14 Juillet - Fête nationale"
Exit Function
ElseIf M = 8 And D = 15 Then
fJourFerie = "15 Août - Assomption"
Exit Function
ElseIf M = 11 And D = 1 Then
fJourFerie = "1er Novembre - Toussaint"
Exit Function
ElseIf M = 11 And D = 11 Then
fJourFerie = "11 Novembre - Armistice 1918"
Exit Function
ElseIf M = 12 And D = 25 Then
fJourFerie = "25 Décembre - Noël"
Exit Function
ElseIf Weekday(dtDate, vbMonday) = 7 Then
fJourFerie = "Dimanche"
Exit Function
Else
tmpDate = fLundiPaques(A)
If dtDate = tmpDate Then
fJourFerie = "Lundi de Pâques"
Exit Function
ElseIf dtDate = tmpDate + 38 Then
fJourFerie = "Ascension"
Exit Function
ElseIf dtDate = tmpDate + 49 Then
fJourFerie = "Lundi de Pentecôte"
Exit Function
End If
End If
End Function
Private Function fLundiPaques(ByVal Iyear As Integer) As Date
'Adapté de +ieurs scripts...
Dim L(6) As Long, Lj As Long, Lm As Long
L(1) = Iyear Mod 19: L(2) = Iyear Mod 4: L(3) = Iyear Mod 7
L(4) = (19 * L(1) + 24) Mod 30
L(5) = ((2 * L(2)) + (4 * L(3)) + (6 * L(4)) + 5) Mod 7
L(6) = 22 + L(4) + L(5)
If L(6) > 31 Then
Lj = L(6) - 31
Lm = 4
Else
Lj = L(6)
Lm = 3
End If
fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
End Function
Conclusion :
Ce code est une adaptation de codes déjà présent sur le site...
Merci de participer à son éventuelle correction !
A+
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.