Les mémos

Fermer Tables

Fermer Requêtes

Fermer Formulaires

Fermer Etats

Fermer Modules

Fermer Base

Fermer Automation

Fermer Administration

Fermer Registre

Fermer String

Fermer Email CDO

Fermer Outlook

Fermer Net

Fermer Dates - Heures

Fermer Fichiers

Fermer Références

Fermer Vrac

Je débute...

Fermer La normalisation

Fermer VBA

Attention
Aucun support
par émail !

Utilisez le forum pour les questions/réponses concernant MsAccess et les codes que vous trouverez sur ce site.
Visites

   visiteurs

   visiteurs en ligne

Dates - Heures - Jours Fériés

Jours fériés

 

Cette fonction permet de savoir si un jour est férié, sans avoir à les gérer dans une table !!

=> Vous avez également besoin de fontion "Easter"

 

Function IsFerie(Jour As Variant) As Boolean

'd'après Ole P Erlandsen

Dim ListeFeries(1 To 11) As Long, i As Integer
Dim tDate As Long, annee As Integer

IsFerie = False

tDate = CDate(Jour)

If tDate < 1 Then Exit Function

annee = Year(tDate)

If annee < 1900 Then Exit Function

'remplit la liste des fériés

ListeFeries(1) = CDate("1/1/" & annee) 'Jour de l'An
ListeFeries(2) = EASTER(annee) + 1 'Lundi de Pâques
ListeFeries(3) = ListeFeries(2) + 38 'Jeudi Ascension
ListeFeries(4) = ListeFeries(2) + 49 'Lundi Pentecôte
ListeFeries(5) = CDate("1/5/" & annee) '1er Mai
ListeFeries(6) = CDate("8/5/" & annee) '8 Mai
ListeFeries(7) = CDate("14/7/" & annee) '14 Juillet
ListeFeries(8) = CDate("15/8/" & annee) '15 Août
ListeFeries(9) = CDate("1/11/" & annee) 'Toussaint
ListeFeries(10) = CDate("11/11/" & annee) '14-18
ListeFeries(11) = CDate("25/12/" & annee) 'Noël

' compare la date entrée avec la Liste des Fériés

i = 1

While i <= UBound(ListeFeries) And IsFerie = False

If tDate = ListeFeries(i) Then IsFerie = True

i = i + 1

Wend

End Function

 


 

Function Easter(Yr As Integer) As Date

' Date of Easter for any year
' Algorithm from Knuth, The Art of Computer Programming

Dim Century As Integer
Dim Sunday As Integer
Dim Epact As Integer
Dim Golden As Integer
Dim LeapDayCorrection As Integer
Dim SynchWithMoon As Integer
Dim N As Integer

' [Golden Number in Metonic cycle]

Golden = (Yr Mod 19) + 1

' [Century]: when Yr is not a multiple of 100,
' Century is the century number

Century = Yr 100 + 1

' [Corrections]
' LeapDayCorrection is the number
' of century years that aren't leap years

LeapDayCorrection = 3 * Century 4 - 12

' SynchWithMoon is a special correction to
' synchronise Easter with the moon's orbit

SynchWithMoon = (8 * Century + 5) 25 - 5

' [Find Sunday]: March((-Sunday mod 7) will be a Sunday

Sunday = 5 * Yr 4 - LeapDayCorrection - 10

' [Epact]: specifies when a full moon occurs.
' If Epact = 25 and the golden number is greater than 11, or
' Epact = 24, then increase Epact by 1

Epact = (11 * Golden + 20 + SynchWithMoon - LeapDayCorrection) Mod 30

If Epact < 0 Then Epact = Epact + 30

If (Epact = 25 And Golden > 11) Or Epact = 24 Then Epact = Epact + 1

' [Find full moon]

N = 44 - Epact

If N < 21 Then N = N + 30

' Easter is the first Sunday following the the first full moon
' which occurs on or after March 21.
' The Nth of March is a calendar full moon.

' [Advance to Sunday]

N = N + 7 - ((Sunday + N) Mod 7)

'Easter is March N or April (N - 31)

Easter = DateSerial(Yr, 3, N)

End Function

 


Date de création : 01/11/2005 : 21:34
Dernière modification : 08/02/2010 : 02:08
Catégorie : Dates - Heures
Page lue 7508 fois


Imprimer l'article Imprimer l'article

Recherche



Lettre d'information
Pour avoir des nouvelles de ce site, inscrivez-vous à notre Newsletter.
Captcha
Recopier le code :
Au sujet de l'auteur
L'auteur qui fréquente (fréquentait) le forum microsoft.public.fr.access a eu le plaisir d'être nommé MVP Office-Access de janvier 2003 à décembre 2011.

Qui sont les MVP ?

Divers ;-)
Nous contacter

Haut