Voici une petite macro (sûrement perfectible) pour tester une date et savoir si elle est fériée.
Bye
MH
Code : Tout sélectionner
Option Explicit
REM Flags
Global initLJFflag As Boolean 'Flag pour indiquer si les jours fériés fixes ont été mémorisés dans les tableaux
Global initLJFvflag As Integer 'Flag pour indiquer si les jours fériés variables ont été mémorisés dans le tableaux et si oui, indique l'année
REM Tableaux
Global lJFFJour(1 To 11) As Integer 'Stock les jours des dates des jours fériés
Global lJFFMois(1 To 11) As Integer 'Stock les mois des dates des jours fériés
Global lJFFTexte(1 To 11) As String 'Stock les noms des jours fériés
'Assigner cette procédure au démarrage de l'application (ça fonctionne sans)
Sub initVar
initLJFflag = False
initLJFvflag = 0
End Sub
REM ++++++++++++++++++++++++ Tableaux jours fériés ++++++++++++++++++++++++
'Initialisation du tableau des jours fériés fixes, doit se faire qu'une fois
Private Sub initListeJF
'Jour de l'an : 1 janvier
'Fête du travail: 1 mai
'Victoire 1945 : 8 mai
'La Révolution : 14 juillet
'L'Assomption : 15 août
'La Toussaint : 1 novembre
'Armistice 1918 : 11 novembre
'Noël : 25 décembre
lJFFJour = array(1,0,1,8,14,0,0,15,1,11,25) ' Liste des jours des jours fériés fixes
lJFFMois = array(1,0,5,5,7,0,0,8,11,11,12) ' Liste des mois des jours fériés fixes
lJFFTexte = array("Jour de l'an","Lundi de pâques","Fête du travail",_
"Victoire 1945","La Révolution","L'Ascension","La Pentecôte",_
"L'Assomption","La Toussaint",_
"Armistice 1918","Noël")
initLJFflag = True 'Les tableaux ont bien été initialisés
End Sub
'Initialisation du tableau des jours fériés variables, peut se faire plusieurs fois si l'année change
Private Sub initListeJV(annee As Integer)
Dim dateTemp As Date
'Recherche du dimanche de pâques
dateTemp = dimancheDePaques(annee)
'Lundi de pâques
lJFFJour(1) = Day(dateTemp + 1)
lJFFMois(1) = Month(dateTemp + 1)
'L'Ascension
lJFFJour(5) = Day(dateTemp + 39
lJFFMois(5) = Month(dateTemp + 39)
'La Pentecôte
lJFFJour(6) = Day(dateTemp + 50)
lJFFMois(6) = Month(dateTemp + 50)
initLJFvflag = annee 'Les tableaux ont bien été initialisés
End Sub
'La fonction renvoie au format date le jour du dimanche de pâques de l'année passée en paramètre
Private Function dimancheDePaques (annee As Integer) As Date
Dim acceder As Object
Dim param As Variant
acceder = CreateUnoService("com.sun.star.sheet.FunctionAccess")
param = Array(annee)
'On accède à la fonction EASTERSUNDAY de Calc pour trouver la date de pâques en fonction d'une année passée en paramètre
dimancheDePaques = acceder.callFunction("EASTERSUNDAY", param())
End Function
REM ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
'#########################################################################
' MACRO à utiliser dans les cellules
' jourFerie (date ; param) -> Exemple jourFerie(A8;-1)
' param : < 0 renvoie -1 pour un jour férié ou 0
' >= 0 renvoie le nom du jour ferié ou une chaîne vide
'#########################################################################
Global Function jourFerie (laDate As Variant, param As Variant) As Variant
Dim a%, b%, c%
On Error Goto errFunc
CompatibilityMode(True)
If IsNumeric(param) Then
'DEBUT ++++++++++++++++++++++++++++++++++++++++++++++
jourFerie = 0 'n'est pas un jour férié
'Si les tableaux n'ont pas été initialiés, lancer l'initialisation.
If initLJFflag = False Then call initListeJF
'Si les tableaux n'ont pas été initialiés ou non pas les valeurs adéquates, lancer l'initialisation.
a = Year(laDate)
If initLJFvflag <> a Then call initListeJV(a)
'Teste notre date avec la liste des jours fériés
b = Month(laDate)
c = Day(laDate)
For a = 0 To 10 Step 1
'Le couple mois jour de notre date correspond-t-il à un jour férié de notre liste ?
If (lJFFMois(a) = b) and (lJFFJour(a) = c) Then
jourFerie = -1 'Est un jour férié
Exit For
EndIf
next a
If param >= 0 Then
If jourFerie Then
jourFerie = lJFFTexte(a) 'Est un jour férié
Else
jourFerie = ""
End If
EndIf
'FIN ------------------------------------------------
Else
jourFerie = "param(1) = date ; param(2) = < 0 ou >= 0"
End If
Exit Function
errFunc:
jourFerie = Error
End Function