Fonction qui renvoie si le jour est férié ou non

Commenter

Contenu du snippet

Slt, voila une petite fonction qui renvoie si le jour est férié ou non...Cool :)

Source / Exemple : 


'-----------------------------------------------------------------------
'CETTE FONCTION N'EST PAS DE MOI!
'Elle est parue dans le SVM n°189 de Janvier 2001 p131
'Auteur: Xavier Milan
'-----------------------------------------------------------------------
'mail:vbtom@free.fr
'site:http://vbtom.phidji.com
'-----------------------------------------------------------------------
'Explications
'Command1 est le bouton où vous cliquez pour savoir si le jour est férié ou non
'Text1 est la TextBox ou vous tapez votre date au format jj/mm/aa
'Label1 est le Label ou apparait la réponses vrai/faux
'Vrai > Le jour est férié
'Faux > Le jour n'est pas férié

Function Ferié(Jour As Date) As Boolean
Dim JJ, AA As Integer
Dim NbOr, Epacte As Integer
Dim PLune, Paques, Ascension, Pentecote As Date

JJ = Day(Jour)
mm = Month(Jour)
AA = Year(Jour)

If JJ = 1 And mm = 1 Then Ferié = True: Exit Function     '1 Janvier
If JJ = 1 And mm = 5 Then Ferié = True: Exit Function     '1 Mai
If JJ = 8 And mm = 5 Then Ferié = True: Exit Function     '8 Mai
If JJ = 14 And mm = 7 Then Ferié = True: Exit Function   '14 Juillet
If JJ = 15 And mm = 8 Then Ferié = True: Exit Function   '15 Août
If JJ = 1 And mm = 11 Then Ferié = True: Exit Function   '1 Novembre
If JJ = 11 And mm = 11 Then Ferié = True: Exit Function '11 Novembre
If JJ = 25 And mm = 12 Then Ferié = True: Exit Function '25 Décembre

NbOr = (AA Mod 19) + 1
Epacte = (11 * NbOr - (3 + Int((2 + Int(AA / 100)) * 3 / 7))) Mod 30
PLune = CDate("19/04/" & AA) - ((Epacte + 6) Mod 30)
If Epacte = 24 Then PLune = PLune - 1
If Epacte = 25 And (AA >= 1900 And AA < 2000) Then PLune = PLune - 1

Paques = PLune - Weekday(PLune) + vbMonday + 7  'Paques
If JJ = Day(Paques) And mm = Month(Paques) Then Ferié = True: Exit Function

Ascension = Paques + 38 'Ascension
If JJ = Day(Ascension) And mm = Month(Ascension) Then Ferié = True: Exit Function

Pentecote = Ascension + 11 'Pentecote
If JJ = Day(Pentecote) And mm = Month(Pentecote) Then Ferié = True: Exit Function
Ferié = False
End Function

Private Sub Command1_Click()
Dim DateFerié As Date
DateFerié = Text1.Text
Label1.Caption = Ferié(DateFerié)
End Sub

Conclusion :


Voila,voila...N'hésiter pas à faire un tour sur mon site ou a m'envoyer un mail si ca bug.
@+

A voir également

S'inscrire maintenant

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.

Du même auteur (vbtom)