Jours fériés y compris mobiles

Soyez le premier à donner votre avis sur cette source.

Snippet vu 4 289 fois - Téléchargée 46 fois

Commenter

Contenu du snippet

Permet d'obtenir les jours fériés y compris les mobiles
Paques, Ascension

Source / Exemple : 


Function JourFerie(madate As Date)
' indique si la date est un jour férié
Dim p_annee As Long
p_annee = Year(madate)
' ajouter paque pentecote et asenscion
If Month(madate) = 1 And Day(madate) = 1 Or _
   Month(madate) = 5 And Day(madate) = 1 Or _
   Month(madate) = 5 And Day(madate) = 8 Or _
   Month(madate) = 7 And Day(madate) = 14 Or _
   Month(madate) = 8 And Day(madate) = 15 Or _
   Month(madate) = 11 And Day(madate) = 1 Or _
   Month(madate) = 11 And Day(madate) = 11 Or _
   Month(madate) = 12 And Day(madate) = 25 Or cdow(madate) = "dimanche" Or _
   madate = LundiPaques(p_annee) Or madate = LundiPaques(p_annee) + 38 Or _
   madate = LundiPaques(p_annee) + 49 Then
   JourFerie = True
Else
   JourFerie = False
End If
   
End Function

Function LundiPaques(p_annee As Long) As Date
' retourne le lundi de paques d'une année
Dim l_lundi As Date, l_1 As Long, l_2 As Long, _
    l_3 As Long, l_4 As Long, l_5 As Long, l_6 As Long _
    , l_j As Long, l_m, l_a
l_1 = Modulo(p_annee, 19)
l_2 = Modulo(p_annee, 4)
l_3 = Modulo(p_annee, 7)
l_4 = Modulo((19 * l_1 + 24), 30)
l_5 = Modulo(((2 * l_2) + (4 * l_3) + (6 * l_4) + 5), 7)
l_6 = 22 + l_4 + l_5
If l_6 > 31 Then
   l_j = l_6 - 31
   l_m = 4
Else
   l_j = l_6
   l_m = 3
End If
l_lundi = Ctod(Padl(Str(l_j), 2, "0") & "/" & Padl(Str(l_m), 2, "0") & "/" & p_annee)
LundiPaques = l_lundi + 1
End Function

Function Ascension(pannee As Long) As Date
 Ascension = LundiPaques(pannee) + 38
End Function
  
Function LundiPentecote(pannee As Long) As Date
   LundiPentecote = LundiPaques(pannee) + 49
End Function

Function Modulo(nombre As Long, diviseur As Long) As Long
' donne le reste d'une division sous une forme plus académique
    Modulo = nombre Mod diviseur
End Function

A voir également

Ajouter un commentaire

Commentaires

Signaler
cs_FloSch
Messages postés
5
Date d'inscription
mardi 7 septembre 2004
Statut
Membre
Dernière intervention
15 février 2013
 -
Bonjour,

Cdow et Ctod ne sont pas des fonctions de conversion de types de données dans Visual Basic.
J'ai remplacé cdow(madate) = "dimanche" par Format(madate,"ddd")="dim."
et Ctod par Cdate.

Cela fonctionne nickel.
Signaler
cs_labout
Messages postés
1356
Date d'inscription
samedi 8 décembre 2001
Statut
Membre
Dernière intervention
23 octobre 2006
 5 -
non c'est du VB Monsieur, il suffir de créer la fonction Padl

Function Padl(cstring As String, length As Integer, character As String) As String
' rempli les blancs de gauche avec lae carattère indiqué
Padl = Right(String(length, character) & cstring, length)
End Function
Signaler
cs_Targhan
Messages postés
13
Date d'inscription
vendredi 22 août 2003
Statut
Membre
Dernière intervention
24 mai 2005
 -
Nan, c'est une instruction Foxpro, qui n'existe pas en vb...
Et d'ailleurs, ça aurait été sympa que l'auteur le précise dans la description du code... -_-
(ou bien poste ce code sur http://www.foxprofr.com à la limite)
Signaler
jodenki
Messages postés
7
Date d'inscription
mercredi 15 mai 2002
Statut
Membre
Dernière intervention
31 mai 2002
 -
J'ai un problème avec le padl.
est-ce une instruction vb .net? (j'utilise vb6).
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 (cs_labout)