Philben - Ms Access » Date

VBA : Date de fin d’une période

philben — Sat, 21 Sep 2013 09:24:50 +0000

Pour faire suite au billet précédent, cette fonction retourne la date de fin de la période choisie (mois, bimestre, trimestre, quadrimestre, semestre et année).

La fonction

Public Function DateFinPeriode(ByVal DateRef As Date, ByVal Periode As Integer) As Date
Select Case Periode
Case 1, 2, 3, 4, 6, 12
DateFinPeriode = DateSerial(Year(DateRef), Int((Month(DateRef) - 1) / Periode) * Periode + Periode + 1, 0)
End Select
End Function

Exemples
Des exemples à exécuter dans la fenêtre ‘Exécution’ (Ctrl+G) de l’éditeur VBA (Alt+F11).

?DateFinPeriode(#2013/09/20#,1) 'Mois -> 30/09/2013
?DateFinPeriode(#2013/09/20#,2) 'Bimestre -> 31/10/2013
?DateFinPeriode(#2013/09/20#,3) 'Trimestre -> 30/09/2013
?DateFinPeriode(#2013/09/20#,4) 'Quadrimestre -> 31/12/2013
?DateFinPeriode(#2013/09/20#,6) 'Semestre -> 31/12/2013
?DateFinPeriode(#2013/09/20#,12) 'Annuelle -> 31/12/2013

Vérification
Résultats dans la fenêtre ‘Exécution’

Public Function TestFinPeriode()
Dim i As Integer, j As Integer, y As Integer, s As String, c As String, r As Date, d As Date
Dim v As Variant, aDerDate(0 To 5) As Date, aCpt(0 To 5) As Integer, bErr As Boolean

'vba.Array retourne toujours un tableau de base zéro (indépendance vis à vis de Option Base) contrairement à Array()
'Mais en règle générale, on utilise Array()
v = VBA.Array(1, 2, 3, 4, 6, 12)

Randomize
y = Int(3000 * Rnd) + 100

Debug.Print "Année aléatoire : " & y
Debug.Print "Mois" & vbTab & " Mensuel(1)" & vbTab & "Bimestre(2)" & vbTab & " Trimes.(3)" & vbTab & " Quadri.(4)" & vbTab & "Semestre(6)" & vbTab & " Année(12)"

'affecte une date initiale non interférente
For j = LBound(aDerDate) To UBound(aDerDate): aDerDate(j) = #5/15/2000#: Next j

For i = 1 To 12
r = DateSerial(y, i, Int(28 * Rnd) + 1) '28 maxi pour février...
s = Format(r, "mm ") & vbTab
For j = LBound(v) To UBound(v)
d = DateFinPeriode(r, v(j))
If d <> aDerDate(j) Then
c = "*"
If Month(d) <> Month(aDerDate(j)) And Year(d) = y Then aCpt(j) = aCpt(j) + 1
Else
c = " "
End If
s = s & c & d & vbTab
aDerDate(j) = d
Next j
Debug.Print s
Next i

For i = LBound(v) To UBound(v)
If aCpt(i) <> 12 \ v(i) Then
Debug.Print "Erreur détectée pour la période n°" & (i + 1)
bErr = True
End If
Next i

If Not bErr Then Debug.Print "Aucune erreur détectée..."
End Function

Philippe

VBA : Date de début d’une période

philben — Fri, 20 Sep 2013 19:11:39 +0000

Je vous présente une fonction qui retourne, en fonction de la date passée en paramètre et la période choisie (Mois, Bimestre, Trimestre, Quadrimestre, Semestre ou Année), la première date de cette période.

La fonction

Public Function DateDebutPeriode(ByVal DateRef As Date, ByVal Periode As Integer) As Date
'Philben - v1.0 - Free to use
Select Case Periode
Case 1, 2, 3, 4, 6, 12
DateDebutPeriode = DateSerial(Year(DateRef), Int((Month(DateRef) - 1) / Periode) * Periode + 1, 1)
End Select
End Function

Paramètres
Le premier paramètre est la date de référence de la période, le deuxième indique le type de période : 1 pour mensuelle, 2 pour bimestrielle, 3 pour trimestrielle, 4 pour quadrimestrielle, 6 pour semestrielle et 12 pour annuelle.

Il y a donc dans une année, 12 périodes mensuelles, 6 bimestres, 4 trimestres, 3 quadrimestres, 2 semestres.

Exemples
Des exemples à exécuter dans fenêtre ‘Exécution’ (Ctrl+G) de l’éditeur VBA (Alt+F11).

?DateDebutPeriode(#2013/09/20#,1) 'Mois -> 01/09/2013

?DateDebutPeriode(#2013/08/20#,2) 'Bimestre -> 01/07/2013
?DateDebutPeriode(#2013/09/20#,2) 'Bimestre -> 01/09/2013

?DateDebutPeriode(#2013/09/20#,3) 'Trimestre -> 01/07/2013
?DateDebutPeriode(#2013/08/20#,4) 'Quadrimestre -> 01/05/2013
?DateDebutPeriode(#2013/09/20#,6) 'Semestre -> 01/07/2013
?DateDebutPeriode(#2013/09/20#,12) 'Annuelle -> 01/01/2013

Vérification
Cette fonction teste chaque période pour chaque mois d’une année choisie aléatoirement.
Un astérisque avant une date indique un changement de période.

Public Function TestDebutPeriode()
Dim i As Integer, j As Integer, y As Integer, s As String, c As String, r As Date, d As Date
Dim v As Variant, aDerDate(0 To 5) As Date, aCpt(0 To 5) As Integer, bErr As Boolean

v = VBA.Array(1, 2, 3, 4, 6, 12)
Randomize
y = Int(3000 * Rnd) + 100

Debug.Print "Année aléatoire : " & y
Debug.Print "Mois" & vbTab & " Mensuel(1)" & vbTab & "Bimestre(2)" & vbTab & " Trimes.(3)" & vbTab & " Quadri.(4)" & vbTab & "Semestre(6)" & vbTab & " Année(12)"

For i = 1 To 12
r = DateSerial(y, i, Int(28 * Rnd) + 1) '28 maxi pour février...
s = Format(r, "mm ") & vbTab
For j = LBound(v) To UBound(v)
d = DateDebutPeriode(r, v(j))
If d <> aDerDate(j) Then
c = "*"
If Day(d) = 1 And Year(d) = y Then aCpt(j) = aCpt(j) + 1
Else
c = " "
End If
s = s & c & d & vbTab
aDerDate(j) = d
Next j
Debug.Print s
Next i

For i = LBound(v) To UBound(v)
If aCpt(i) <> 12 \ v(i) Then
Debug.Print "Erreur détectée pour la période n°" & (i + 1)
bErr = True
End If
Next i

If Not bErr Then Debug.Print "Aucune erreur détectée..."
End Function

Philippe

VBA : S’agit-il d’un jour ouvré non chômé ?

philben — Tue, 27 Aug 2013 21:12:21 +0000

La fonction VBA présentée dans ce billet permet de savoir si la date passée en argument correspond à un jour ouvré (du lundi au vendredi) non chômé (non férié) en France.

Dépendances de la fonction
Nécessite la fonction EstJourFerie() et la fonction Paques().

Le code de la fonction

Public Function EstJourOuvreNonChome(ByVal laDate As Date, Optional ByVal EstPentecoteChome As Boolean = True) As Boolean
'Retourne Vrai si la date est un jour ouvré (du lundi au vendredi) NON férié (non chômé)
'philben - free to use
If Weekday(laDate, vbMonday) < 6 Then
If Not EstJourFerie(laDate, EstPentecoteChome) Then EstJourOuvreNonChome = True
End If
End Function

Explications
La fonction retourne Vrai si la date passée en argument correspond à un jour ouvré non chômé.
Cette fonction admet un deuxième paramètre qui permet de définir si le jour de la Pentecôte est chômé (Vrai par défaut) ou non.

La ligne de code ‘If Weekday(…)’ filtre les jours de semaine pour ne conserver que les jours ouvrés (du lundi au vendredi). On utilise ensuite la fonction EstJourFerie(…) qui retourne Vrai s’il s’agit d’un jour férié.

Vérification des résultats
La fonction suivante compte les jours ouvrés non chômés pour différentes années puis compare le résultat avec la valeur attendue (données issues de ce site).

Public Function TestEstJourOuvreNonChome()
Dim v() As Variant, d As Date, l As Integer, i As Integer, NbErr As Integer

v = Array(2010, 254, 2011, 253, 2012, 253, 2013, 251, 2014, 251, 2015, 252, 2016, 253, 2021, 254)
For i = LBound(v) To UBound(v) Step 2
d = DateSerial(v(i), 1, 1)
While Year(d) = v(i)
If EstJourOuvreNonChome(d) Then l = l + 1
d = d + 1
Wend
If l <> v(i + 1) Then NbErr = NbErr + 1
Debug.Print "Nb jours ouvrés non chômés en " & v(i), " -> Attendu : " & v(i + 1), " -> Obtenu : " & l, IIf(l <> v(i + 1), "*** ERREUR ***", "")
l = 0
Next i
Debug.Print "Nombre d'erreur(s) : " & NbErr
End Function

Remarque : Le lundi de Pentecôte est considéré comme chômé ici.

Philippe

VBA : Date d’un premier jour de semaine du mois

philben — Thu, 15 Aug 2013 13:56:40 +0000

Episode VI de la saga ‘Weekday’. Cette fois-ci, on introduit la notion de mois puisque l’on souhaite obtenir la date d’un premier jour de semaine du mois de la date de référence. Quelle est la date du premier dimanche du mois ? La date du premier lundi du mois ?

Préambule
Je vous conseille de lire le premier billet de ‘Weekday’ pour comprendre le principe des calculs.
Voir aussi le récapitulatif des fonctions.

La fonction VBA
Nécessite la fonction DateJourSuivant()

Public Function DateJourDebutMois(ByVal DateRef As Date, ByVal Jour As VbDayOfWeek) As Date
DateJourDebutMois = DateJourSuivant(DateRef - Day(DateRef), Jour)
End Function

Pour atteindre rapidement le dernier jour du mois précédent, on soustrait à la date de référence son jour du mois. Par exemple le 15 août – 15 donnera le 31 juillet.
On recherche ensuite le jour de semaine souhaité qui suit le dernier jour du mois précédent grâce à notre fonction DateJourSuivant().

Tester la fonction
Affiche les résultats dans la fenêtre ‘Exécution’ de l’éditeur VB.

Public Function TestDateJourDebutMois()
Dim s As String, d As Date, dm As Date, djdm As Date
Dim i As Integer, j As Integer, NbErr As Integer

Debug.Print "Test DateJourDebutMois()" & vbCrLf & "----------------------"

d = Int(Now())
While Weekday(d) <> vbMonday: d = d + 1: Wend
Debug.Print "* Semaine de référence du " & Format(d, "dddd dd/mm/yyyy") & " au " & Format(d + 6, "dddd dd/mm/yyyy")

For i = 1 To 7
dm = DateSerial(Year(d), Month(d), 1)
j = i Mod 7 + 1
While Weekday(dm) <> j: dm = dm + 1: Wend

djdm = DateJourDebutMois(d, Weekday(d))
s = s & vbTab & "-> Jour recherché : " & Format(dm, "ddd dd/mm/yyyy") & " - Jour trouvé : " & Format(djdm, "ddd dd/mm/yyyy") & vbCrLf
If djdm <> dm Then NbErr = NbErr + 1
d = d + 1
Next i
Debug.Print s & "***" & IIf(NbErr > 0, NbErr, " Aucune") & " erreur(s) commise(s) ***"
End Function

@+ pour la suite des épisodes ‘Weekday’.

Philippe

VBA : S’agit-il d’un jour de week-end ?

philben — Thu, 15 Aug 2013 11:55:58 +0000

Une petite fonction qui permet de savoir si la date passée en argument correspond à une jour de week-end ou non.

La fonction VBA

Public Function EstWeekEnd(ByVal dDate As Date) As Boolean
If Weekday(dDate, vbMonday) > 5 Then EstWeekEnd = True
End Function

Elle retourne Vrai si la date est un samedi ou un dimanche sinon elle renvoie Faux par défaut.

Principe
On impose à ‘Weekday()’ que le 1er jour de semaine est le lundi (constante ‘vbMonday’) et non le dimanche par défaut. Ainsi, le 6ème et le 7ème jour sont le samedi et le dimanche.

Exemples
Dans la fenêtre Exécution du VBE.

?EstWeekEnd(#2013/8/16#) 'Vendredi 16 août 2013 : Faux
?EstWeekEnd(#2013/8/17#) 'Samedi 17 août 2013 : Vrai
?EstWeekEnd(#2013/8/18#) 'Dimanche 18 août 2013 : Vrai
?EstWeekEnd(#2013/8/19#) 'Lundi 19 août 2013 : Faux

Philippe

VBA : Récapitulatif des fonctions ‘jour de semaine’

philben — Thu, 15 Aug 2013 11:15:36 +0000

Dans ces exemples, on recherche la date d’un mercredi. Le mercredi avec une croix rouge indique le mercredi retourné selon la fonction utilisée et le jour de la date de référence.

DateJourSemaineEnCours() renvoie toujours la date du mercredi de la semaine quelque soit le jour de la date de référence
DateJourMemeOuPrecedent() renvoie la date du mercredi qui précède la date de référence ou la date de référence elle-même s’il s’agit d’un mercredi
DateJourPrecedent() renvoie la date du mercredi qui précède la date de référence
DateJourMemeOuSuivant() renvoie la date du mercredi qui suit la date de référence ou la date de référence elle-même s’il s’agit d’un mercredi
DateJourSuivant() renvoie la date du mercredi qui suit la date de référence

Remarque
Les fonctions décrites peuvent provoquer une erreur (dépassement de capacité – Erreur n°6) :

si on passe une date proche du 1er janvier de l’an 100 aux fonctions ayant un balayage arrière
si on passe une date proche du 31 décembre 9999 aux fonctions ayant un balayage avant

En effet, on peut dépasser dans ces cas, la plage des dates autorisées par Access. Pour ne pas lever cette erreur, vous pouvez introduire un gestionnaire d’erreur dans les fonctions.

Philippe

Date d’un jour de la semaine courante

philben — Thu, 08 Nov 2012 18:17:01 +0000

Episode V de la saga ‘Weekday’. Cette fois-ci, on introduit la notion de semaine puisque l’on souhaite obtenir la date d’un jour quelconque de la semaine de la date de référence. Quelle est la date du dimanche de cette semaine ? La date du mardi ?

Préambule
Je vous conseille de lire le premier billet de ‘Weekday’ pour comprendre le principe des calculs.
Voir aussi le récapitulatif des fonctions.

Les matrices
On souhaite donc passer de la matrice ‘Weekday’ à la matrice ‘Jour de la semaine courante’. Si le premier jour de semaine est un lundi (qui peut être le dimanche comme aux U.S.A.), la matrice finale est :

Weekday(Date,VbDayOfWeek) Jour de la semaine (1er jour : lundi)
VbDayOfWeek VbDayOfWeek
Jour Date L M M J V S D Jour date L M M J V S D
Lundi 1 7 6 5 4 3 2 Lundi 0 1 2 3 4 5 6
Mardi 2 1 7 6 5 4 3 Mardi -1 0 1 2 3 4 5
Mercredi 3 2 1 7 6 5 4 vers Mercredi -2 -1 0 1 2 3 4
Jeudi 4 3 2 1 7 6 5 Jeudi -3 -2 -1 0 1 2 3
Vendredi 5 4 3 2 1 7 6 Vendredi -4 -3 -2 -1 0 1 2
Samedi 6 5 4 3 2 1 7 Samedi -5 -4 -3 -2 -1 0 1
Dimanche 7 6 5 4 3 2 1 Dimanche -6 -5 -4 -3 -2 -1 0

On remarque que les valeurs sont symétriquement opposées par rapport à la diagonale. Pour pouvoir gérer tous les cas quelque soit le premier jour de semaine, le plus simple est de se servir de ce premier jour de semaine comme pivot.

La fonction VBA

Public Function DateJourSemaineEnCours(ByVal DateRef As Date, ByVal Jour As VbDayOfWeek, _
Optional ByVal PremierJourDeSemaine As VbDayOfWeek = vbMonday) As Date
DateJourSemaineEnCours = DateRef + (Jour - CInt(Weekday(DateRef, PremierJourDeSemaine)) - PremierJourDeSemaine + 1)
If Jour < PremierJourDeSemaine Then DateJourSemaineEnCours = DateJourSemaineEnCours + 7
End Function

La fonction admet trois paramètres : La date de référence et le jour de semaine recherché. Le troisième paramètre est optionnel (PremierJourDeSemaine) et contient sous forme de constante le nom du 1er jour de semaine. La valeur par défaut de ce paramètre est lundi.

Tester la fonction
La fonction suivante teste les 49 x 7 possibilités des matrices et affiche les résultats dans la fenêtre ‘Exécution’ de l’éditeur VB.

Public Function TestDateJourSemaineEnCours()
Dim s As String, d As Date, dates(1 To 7) As Date
Dim i As Integer, j As Integer, k As Integer, l As Integer, NbErr As Integer, SumErr As Integer

d = Int(Now())
Debug.Print "Test DateJourSemaineEnCours()" & vbCrLf & "----------------------"
For l = 1 To 7
d = Int(Now())
While Weekday(d) <> l: d = d + 1: Wend
For k = 0 To 6: dates(Weekday(d + k)) = d + k: Next k

Debug.Print "* Semaine du " & Format(d, "dddd dd/mm/yyyy") & " au " & Format(d + 6, "dddd dd/mm/yyyy")
For i = 1 To 7
NbErr = 0
s = vbTab & "-> Jour recherché : " & Format(d + i - 1, "ddd dd/mm/yyyy") & " : "

For j = 0 To 6
If DateJourSemaineEnCours(d + j, i, l) <> dates(i) Then NbErr = NbErr + 1
Next j
Debug.Print s & IIf(NbErr > 0, NbErr, " Aucune") & " erreur(s)"
SumErr = SumErr + NbErr
Next
Next l
Debug.Print "***" & IIf(SumErr > 0, SumErr, " Aucune") & " erreur(s) commise(s) ***"
End Function

Exemples
A coller dans la fenêtre ‘Exécution’ du VBE.

'Date du dimanche pour la date donnée et pour une semaine commençant le lundi
?DateJourSemaineEnCours(#2012/11/8#,vbSunday) '11/11/2012
'Date du lundi pour la date donnée et pour une semaine commençant le lundi
?DateJourSemaineEnCours(#2012/11/8#,vbMonday) '05/11/2012
'Date du dimanche pour la date donnée et pour une semaine commençant le dimanche
?DateJourSemaineEnCours(#2012/11/8#,vbSunday,vbSunday) '04/11/2012

@+ pour la suite des épisodes ‘Weekday’.

Philippe

Date du jour-même ou précédent

philben — Fri, 02 Nov 2012 11:53:31 +0000

Episode IV de la saga ‘Weekday’. On souhaite obtenir cette fois-ci, la date d’un jour de semaine qui précède ou NON la date de référence.

Préambule
Je vous conseille de lire le premier billet de ‘Weekday’ pour comprendre le principe des calculs.
Voir aussi le récapitulatif des fonctions.

Les matrices
On souhaite donc passer de la matrice ‘Weekday’ à la matrice ‘Jour courant ou précédent’

Weekday(Date,VbDayOfWeek) Jour courant ou précédent
VbDayOfWeek VbDayOfWeek
Jour Date L M M J V S D Jour date L M M J V S D
Lundi 1 7 6 5 4 3 2 Lundi 0 -6 -5 -4 -3 -2 -1
Mardi 2 1 7 6 5 4 3 Mardi -1 0 -6 -5 -4 -3 -2
Mercredi 3 2 1 7 6 5 4 vers Mercredi -2 -1 0 -6 -5 -4 -3
Jeudi 4 3 2 1 7 6 5 Jeudi -3 -2 -1 0 -6 -5 -4
Vendredi 5 4 3 2 1 7 6 Vendredi -4 -3 -2 -1 0 -6 -5
Samedi 6 5 4 3 2 1 7 Samedi -5 -4 -3 -2 -1 0 -6
Dimanche 7 6 5 4 3 2 1 Dimanche -6 -5 -4 -3 -2 -1 0

On remarque que toutes les valeurs de la matrice finale sont les opposés + 1 de la matrice ‘Weekday’. Par exemple, si la date de référence est un lundi, le mardi sera 1 – 7 = -6, le dimanche sera 1 – 2 = -1 et pour les valeurs de la diagonale, la formule est 1 – 1 = 0.

La fonction VBA

Public Function DateJourMemeOuPrecedent(ByVal DateRef As Date, ByVal Jour As VbDayOfWeek) As Date
DateJourMemeOuPrecedent = DateRef - CInt(Weekday(DateRef, Jour)) + 1
End Function

Tester la fonction
La fonction suivante teste les 49 possibilités de la matrice et affiche les résultats dans la fenêtre ‘Exécution’ de l’éditeur VB.

Public Function TestDateJourMemeOuPrecedent()
Dim d As Date, r As Date, dates(1 To 7) As Date
Dim i As Integer, j As Integer, k As Integer, NbErr As Integer
Dim s As String, Jours As Variant

d = Int(Now())
While Weekday(d) <> vbMonday: d = d + 1: Wend
Jours = VBA.Array("Dimanche", "Lundi ", "Mardi ", "Mercredi", "Jeudi ", "Vendredi", "Samedi ")

Debug.Print "Test DateJourMêmeOuPrecedent()" & vbCrLf & "----------------------"
For i = 1 To 7
s = vbNullString
Debug.Print "* Date de référence : " & Format(d, "dddd dd/mm/yyyy")
Debug.Print vbTab & "Jour cherché" & vbTab & vbTab & "Jour trouvé" & vbTab & vbTab & "Conforme ?" & vbCrLf & _
vbTab & "----------------------------------------------"
For k = 1 To 6: dates(Weekday(d - k)) = d - k: Next k
dates(Weekday(d)) = d

For j = 1 To 7
r = DateJourMemeOuPrecedent(d, j)
s = s & vbTab & Jours(j - 1) & vbTab & vbTab & Format(r, "ddd dd/mm/yyyy") & vbTab & vbTab
If r <> dates(j) Then
NbErr = NbErr + 1
s = s & "Erreur !" & vbCrLf
Else
s = s & "Ok" & vbCrLf
End If
Next j
Debug.Print s
d = d + 1
Next i
Debug.Print "***" & IIf(NbErr > 0, NbErr, " Aucune") & " erreur(s) commise(s) ***"
End Function

@+ pour la suite des épisodes ‘Weekday’.

Philippe

S’agit-il d’un jour férié ?

philben — Sun, 28 Oct 2012 18:01:27 +0000

Je vous présente une fonction écrite en VBA qui détermine si la date passée en argument correspond à un jour férié français ou non. La réponse est obtenue en moins d’un millionième de seconde !

Les jours fériés légaux en France
Ils sont au nombre de 11 dont 8 sont fixes (1er janvier, 1er mai, 8 mai, 14 juillet, 15 août, 1er novembre, 11 novembre et 25 décembre) et 3 mobiles (Lundi de Pâques, Jeudi de l’Ascension et Lundi de Pentecôte).
le Lundi de Pentecôte (journée de solidarité) est férié mais il peut être non chômé selon l’entreprise. Un jour férié fixe n’est pas non plus obligatoirement chômé puisqu’il peut tomber un jour de week-end par exemple.

La fonction en VBA
La fonction utilise la fonction Paques() qui détermine la date du Dimanche de Pâques. Il faut donc que cette fonction soit présente dans le même projet ou module de code standard.

Public Function EstJourFerie(ByVal laDate As Date, Optional ByVal EstPentecoteFerie As Boolean = True) As Boolean
'Détermine si la date passée en argument est un jour férié (en France) ou non :
' 101 = 1er Janvier - 501 = 1er Mai - 508 = 8 Mai - 714 = 14 Juillet
' 815 = 15 Août - 1101 = 1er Novembre - 1111 = 11 Novembre - 1225 = 25 Décembre
' dPa = Lundi de Pâques - dAs = Jeudi de l'Ascension - dPe = Lundi de Pentecôte
'Remarque : Le lundi de Pentecôte est un jour férié mais parfois non chômé (EstPentecoteFerie = False dans ce cas)
'Philben - v1.0 - 2012 - Free to use
Static Annee As Integer, dPa As Date, dAs As Date, dPe As Date, bPe As Boolean
Dim a As Integer, m As Integer, j As Integer

a = Year(laDate): m = Month(laDate): j = Day(laDate)
Select Case m * 100 + j
Case 101, 501, 508, 714, 815, 1101, 1111, 1225
EstJourFerie = True
Case 323 To 614 '323: Date mini Lundi de Pâques - 614 : Date maxi Lundi de Pentecôte
If a <> Annee Or EstPentecoteFerie <> bPe Then
Annee = a: dPa = Paques(a) + 1: dAs = dPa + 38
bPe = EstPentecoteFerie: If bPe Then dPe = dPa + 49 Else dPe = #1/1/100#
End If
Select Case DateSerial(a, m, j): Case dPa, dAs, dPe: EstJourFerie = True: End Select
End Select
End Function

Explications
La fonction retourne Vrai si la date passée en argument correspond à un jour férié. Le deuxième argument optionnel permet de définir si le lundi de Pentecôte est réellement férié (non travaillé) ou non.
On teste tout d’abord la date par rapport aux jours fériés fixes. Ensuite, si elle ne correspond pas à l’une de ces dates, on vérifie si elle est située dans la période théorique de l’année des jours fériés mobiles entre la date du Lundi de Pâques (23 mars au plus tôt) et le lundi de Pentecôte (14 juin au plus tard) en sachant que l’Ascension est comprise entre ces deux dates. Si c’est le cas, on compare la date à ces 3 jours.
La date de ces 3 jours mobiles est conservée dans une variable ‘Static’ pour éviter un recalcul inutile si l’année ne change pas entre deux appels et si le statut du lundi de Pentecôte n’est pas modifié.

Vérification des résultats
La fonction suivante contrôle notre fonction par rapport aux résultats de la fonction EstFerie() de la F.A.Q. qui est donc à télécharger.

Public Function TestResultatJourFerie()
Dim a As Integer, m As Integer, j As Integer, d As Date, bErr As Boolean

'Plage de EstFerie : 1982 à 2048
For a = 1982 To 2048
For m = 1 To 12
For j = 1 To 31
d = DateSerial(a, m, j)
If EstJourFerie(d) <> EstFerie(d) Then
bErr = True
Debug.Print "Date : " & d; " - EstJourFerie() : " & EstJourFerie(d) & " - EstFerie() " & EstFerie(d)
End If
Next j
Next m
Next a
Debug.Print "Fin TestResultatJourFerie() - " & IIf(bErr, "Erreur(s) détectée(s)", "Aucune erreur détectée")
End Function

Compléments à venir
Nous verrons dans des prochains billets comment utiliser cette fonction dans des cas plus spécifiques : S’agit-il d’un jour de week-end ou d’un jour férié, s’agit-il d’un jour ouvré non travaillé,…

Philippe

Date du jour de semaine précédent

philben — Fri, 26 Oct 2012 03:40:25 +0000

Episode III de la saga ‘Weekday’. On souhaite obtenir cette fois-ci, la date d’un jour de semaine qui précède la date de référence.

Préambule
Je vous conseille de lire le premier billet de ‘Weekday’ pour comprendre le principe des calculs.
Voir aussi le récapitulatif des fonctions.

Les matrices
On souhaite donc passer de la matrice ‘Weekday’ à la matrice ‘Jour précédent’

Weekday(Date,VbDayOfWeek) Jour précédent
VbDayOfWeek VbDayOfWeek
Jour Date L M M J V S D Jour date L M M J V S D
Lundi 1 7 6 5 4 3 2 Lundi -7 -6 -5 -4 -3 -2 -1
Mardi 2 1 7 6 5 4 3 Mardi -1 -7 -6 -5 -4 -3 -2
Mercredi 3 2 1 7 6 5 4 vers Mercredi -2 -1 -7 -6 -5 -4 -3
Jeudi 4 3 2 1 7 6 5 Jeudi -3 -2 -1 -7 -6 -5 -4
Vendredi 5 4 3 2 1 7 6 Vendredi -4 -3 -2 -1 -7 -6 -5
Samedi 6 5 4 3 2 1 7 Samedi -5 -4 -3 -2 -1 -7 -6
Dimanche 7 6 5 4 3 2 1 Dimanche -6 -5 -4 -3 -2 -1 -7

On remarque que les lignes de la matrice ‘Jour précédent’ correspondent aux lignes de la matrice ‘Weekday’ avec un décalage de 1 jour.
Par exemple, la ligne du lundi de ‘Jour précédent’ est identique en valeur absolue à celle du dimanche de ‘Weekday’, celle du mardi est liée à lundi, etc…

La solution
Il faut donc retrancher un jour à la date de référence avant de la passer à la fonction Weekday() : Weekday(DateRef - 1, Jour)

La fonction VBA

Public Function DateJourPrecedent(ByVal DateRef As Date, ByVal Jour As VbDayOfWeek) As Date
DateJourPrecedent = DateRef - Weekday(DateRef - 1, Jour)
End Function

Tester la fonction
La fonction suivante teste les 49 possibilités de la matrice et affiche les résultats dans la fenêtre ‘Exécution’ de l’éditeur VB.

Public Function TestDateJourPrecedent()
Dim d As Date, r As Date, dates(1 To 7) As Date
Dim i As Integer, j As Integer, k As Integer, NbErr As Integer
Dim s As String, Jours As Variant

d = Int(Now())
While Weekday(d) <> vbMonday: d = d + 1: Wend
Jours = VBA.Array("Dimanche", "Lundi ", "Mardi ", "Mercredi", "Jeudi ", "Vendredi", "Samedi ")

Debug.Print "Test DateJourPrecedent()" & vbCrLf & "----------------------"
For i = 1 To 7
s = vbNullString
Debug.Print "* Date de référence : " & Format(d, "dddd dd/mm/yyyy")
Debug.Print vbTab & "Jour cherché" & vbTab & vbTab & "Jour trouvé" & vbTab & vbTab & "Conforme ?" & vbCrLf & _
vbTab & "----------------------------------------------"
For k = 1 To 7: dates(Weekday(d - k)) = d - k: Next k

For j = 1 To 7
r = DateJourPrecedent(d, j)
s = s & vbTab & Jours(j - 1) & vbTab & vbTab & Format(r, "ddd dd/mm/yyyy") & vbTab & vbTab
If r <> dates(j) Then
NbErr = NbErr + 1
s = s & "Erreur !" & vbCrLf
Else
s = s & "Ok" & vbCrLf
End If
Next j
Debug.Print s
d = d + 1
Next i
Debug.Print "***" & IIf(NbErr > 0, NbErr, " Aucune") & " erreur(s) commise(s) ***"
End Function

@+ pour la suite des épisodes ‘Weekday’.

Philippe