Jours fériés

**djool** · 29/10/2004, 15h12

Bonjour,

Voila j'ai une fonction qui me permet de calculer le nombre d'heure entre 2 dates :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Function Total(date_debut As Date, date_fin As Date)
 Dim Total1 As Single
 Total = 0
 For j = date_debut To date_fin
  'Lundi à Jeudi
  If Weekday(j) = 2 Or Weekday(j) = 3 Or Weekday(j) = 4 Or Weekday(j) = 5 Then Total = Total + 8.5
  'Vendredi
  If Weekday(j) = 6 Then Total = Total + 5
  If Weekday(j) = 7 Or Weekday(j) = 1 Then Total = Total + 0
  Next j
 
 
End Function

(fonction que l'on m'a donnée sur developpez.com)

Seul inconvénient de cette fonction c'est quelle ne prend en compte les jours Férié.

J'ai donc récupérer une fonctionpour rcéer une etable jours fériés:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
 
Public Function TableauJoursFériés(wAn%)
' Objectif: Créer la tblJoursFériés pour l'année entrée en argument
Dim dtPaques As Date, dtVenSaint As Date, dtLunPaq As Date, dtAscension As Date
Dim dtDimPent As Date, dtLunPent As Date, dtLunJeune As Date
Dim strMsg As String, strTitre As String
Dim TableauJoursFeriés(11), i As Integer
Dim TableauNomsJFeriés(11) As String, rs As Recordset
dtPaques = fPaques(wAn%)
dtVenSaint = dtPaques - 2
dtLunPaq = dtPaques + 1
dtAscension = dtPaques + 39
dtDimPent = dtPaques + 49
dtLunPent = dtPaques + 50
dtLunJeune = JourSemSuivant(2, "15/09/" & wAn%)
strTitre = "Dates des jours fériés de l'an " & wAn%
strMsg = "Nouvel an : " & "01/01/" & wAn% & vbCr & "Vendredi Saint : " & dtVenSaint & vbCr & _
"Pâques : " & dtPaques & vbCr & "Lundi de Pâques : " & dtLunPaq & vbCr & "Ascension : " & _
dtAscension & vbCr & "Dimanche de Pentecôte : " & dtDimPent & vbCr & _
"Lundi de Pentecôte : " & dtLunPent & vbCr & "Fête nationale : " & "01/08/" & wAn% & vbCr & _
"Lundi du Jeûne Fédéral : " & dtLunJeune & vbCr & "Noël : " & "25/12/" & wAn% & vbCr & _
"St-Etienne : " & "26/12/" & wAn%
MsgBox strMsg, vbInformation, strTitre
TableauNomsJFeriés(1) = "Nouvel-An"
TableauJoursFeriés(1) = "01/01/" & wAn%
TableauNomsJFeriés(2) = "Vendredi-Saint"
TableauJoursFeriés(2) = dtVenSaint
TableauNomsJFeriés(3) = "Pâques"
TableauJoursFeriés(3) = dtPaques
TableauNomsJFeriés(4) = "Lundi de Pâques"
TableauJoursFeriés(4) = dtLunPaq
TableauNomsJFeriés(5) = "Ascension"
TableauJoursFeriés(5) = dtAscension
TableauNomsJFeriés(6) = "Pentecôte"
TableauJoursFeriés(6) = dtDimPent
TableauNomsJFeriés(7) = "Lundi de Pentecôte"
TableauJoursFeriés(7) = dtLunPent
TableauNomsJFeriés(8) = "Fête Nationale"
TableauJoursFeriés(8) = "01/08/" & wAn%
TableauNomsJFeriés(9) = "Lundi du Jeûne Fédéral"
TableauJoursFeriés(9) = dtLunJeune
TableauNomsJFeriés(10) = "Noël"
TableauJoursFeriés(10) = "25/12/" & wAn%
TableauNomsJFeriés(11) = "St-Etienne"
TableauJoursFeriés(11) = "26/12/" & wAn%
Set rs = CurrentDb.OpenRecordset("tblJoursFériés")
' Peupler la tblJoursFériés
For i = 1 To 11
   rs.AddNew
   rs!NomJourFérié = TableauNomsJFeriés(i)
   rs!DateJourFérié = TableauJoursFeriés(i)
   rs.Update
Next i
End Function

Mais je n'arrive pas l'utiliser.

Quand je compile le code il s'arrete sur fpaques en me mettant erreur de compilation end sub manquant etc...

Ma question comment retourner le le jour auquel correspond un jour férié afin de ne prendre en compte que le nombre d'heure dédiée aà ce jour ( ref/ fonction total pour le nombre d'heure de chaque jour)

Aussi j'aimerai créer un enregistrement pour chaque salarié pour chaque jour fériés.
Comment FAIRE?

**argyronet** · 29/10/2004, 17h08

Bonjour,

La fonction que tu as récupéré retourne un tableau de string stipulant une fête en particulier et la date mais il faut l'adapter. De plus il manque des sous-fonctions comme Pâques etc...
Ta boucle doit parcourir les dates et vérifier que ce n'est pas un jour férié.

Voilà un exemple:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
Sub Test()
	MsgBox Total(#1/1/2004#, #5/6/2004#)
End Sub
 
Function Total(ByVal date_debut As Date, ByVal date_fin As Date) As Single
 Dim TotalHeures As Single
 Dim D As Date
 
  Total = 0
  D = date_debut
 
  Do While D <= date_fin
    If EstFerié(D) Then
      TotalHeures = TotalHeures + 0
    Else
      Select Case Weekday(D)
        Case 2 To 5 'Lundi à Jeudi
          TotalHeures = TotalHeures + 8.5
        Case 6 'Vendredi
          TotalHeures = TotalHeures + 5
        Case 1, 7
        TotalHeures = TotalHeures + 0
      End Select
    End If
    D = D + 1
  Loop
  Total = TotalHeures
End Function
 
Function EstFerié(ByVal QuelleDate As Date) As Boolean
Dim anneeDate As Integer
Dim joursFeries(1 To 11) As Date
Dim I As Integer
  anneeDate = Year(QuelleDate)
 
  joursFeries(1) = CDate("01/01/" & anneeDate)
  joursFeries(2) = CDate("01/05/" & anneeDate)
  joursFeries(3) = CDate("08/01/" & anneeDate)
  joursFeries(4) = CDate("14/07/" & anneeDate)
  joursFeries(5) = CDate("15/08/" & anneeDate)
  joursFeries(6) = CDate("01/11/" & anneeDate)
  joursFeries(7) = CDate("11/11/" & anneeDate)
  joursFeries(8) = CDate("25/12/" & anneeDate)
  ' Lundi de Pâques = Paques + 1
  ' Ascension = Paques + 39
  ' Lundi Pentecôte = Paques + 50
  joursFeries(9) = JourDePaques(anneeDate)
  joursFeries(10) = joursFeries(1) + 39
  joursFeries(11) = joursFeries(1) + 50
 
  For I = 1 To 11
    If QuelleDate = joursFeries(I) Then
      EstFerié = True
      Exit For
    End If
  Next
End Function
 
Public Function JourDePaques(Annee) As Date
    Dim a, b, c, d, e, f, g, h, I, k, l, m, n, p As Integer
    a = Int(Annee Mod 19)
    b = Int(Annee \ 100)
    c = Int(Annee Mod 100)
    d = b \ 4
    e = b Mod 4
    f = (b + 8) \ 25
    g = (b - f + 1) \ 3
    h = (19 * a + b - d - g + 15) Mod 30
    I = c \ 4
    k = c Mod 4
    l = (32 + 2 * e + 2 * I - h - k) Mod 7
    m = (a + 11 * h + 22 * l) \ 451
    n = (h + l - 7 * m + 114) \ 31
    p = (h + l - 7 * m + 114) Mod 31
    JourDePaques = DateSerial(Annee, n, p + 1)
End Function

P.S. j'ai récupéré la fonction Pâques sur le Net n'ayant pas la mienne sous la main
(merci Patrice MANGIN)

Argy

**cafeine** · 29/10/2004, 17h22

j'ai une ptite fonction sinon

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
Function DonneJoursOuvresIntervalle(ByVal dt0 As Date, ByVal dt1 As Date) As Integer
Dim i As Date
 
DonneJoursOuvresIntervalle = 0
 
For i = dt0 To dt1
    Debug.Print i, DonneJour(i, "ouvré")
    If Len(DonneJour(i, "ouvré")) = 0 Then
        DonneJoursOuvresIntervalle = DonneJoursOuvresIntervalle + 1
    End If
Next i
 
End Function
 
Function DonneJour(ByVal dtDate As Date, ByVal TypeJour As String) As String
 
        Dim A As Integer, M As Integer, d As Integer
        Dim tmpDate As Date
 
        A = Year(dtDate): M = Month(dtDate): d = Day(dtDate)
 
 
Select Case TypeJour
 
    Case "ouvrable"
        If WeekDay(dtDate, vbMonday) > 5 Then
                DonneJour = "week-end"
                Exit Function
        End If
 
    Case "ouvré"
 
        If M = 1 And d = 1 Then
                DonneJour = "1er Janvier - Jour de l'An"
                Exit Function
        ElseIf M = 5 And d = 1 Then
                DonneJour = "1er Mai - Fête du Travail"
                Exit Function
        ElseIf M = 5 And d = 8 Then
                DonneJour = "8 Mai - Victoire 1945"
                Exit Function
        ElseIf M = 7 And d = 14 Then
                DonneJour = "14 Juillet - Fête nationale"
                Exit Function
        ElseIf M = 8 And d = 15 Then
                DonneJour = "15 Août - Assomption"
                Exit Function
        ElseIf M = 11 And d = 1 Then
                DonneJour = "1er Novembre - Toussaint"
                Exit Function
        ElseIf M = 11 And d = 11 Then
                DonneJour = "11 Novembre - Armistice 1918"
                Exit Function
        ElseIf M = 12 And d = 25 Then
                DonneJour = "25 Décembre - Noël"
                Exit Function
        ElseIf WeekDay(dtDate, vbMonday) > 5 Then
                DonneJour = Format(dtDate, "dddd")
                Exit Function
        Else
 
                tmpDate = fLundiPaques(A)
 
                If dtDate = tmpDate Then
                        DonneJour = "Lundi de Pâques"
                        Exit Function
                ElseIf dtDate = tmpDate + 38 Then
                        DonneJour = "Jeudi de l'Ascension"
                        Exit Function
                ElseIf dtDate = tmpDate + 49 Then
                        DonneJour = "Lundi de Pentecôte"
                        Exit Function
                End If
 
        End If
 
    End Select
 
End Function
 
Private Function fLundiPaques(ByVal Iyear As Integer) As Date
        'Adapté de +ieurs scripts...
        Dim L(6) As Long, Lj As Long, Lm As Long
 
        L(1) = Iyear Mod 19: L(2) = Iyear Mod 4: L(3) = Iyear Mod 7
        L(4) = (19 * L(1) + 24) Mod 30
        L(5) = ((2 * L(2)) + (4 * L(3)) + (6 * L(4)) + 5) Mod 7
        L(6) = 22 + L(4) + L(5)
 
        If L(6) > 31 Then
                Lj = L(6) - 31
                Lm = 4
        Else
                Lj = L(6)
                Lm = 3
        End If
 
        fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
 
End Function

**djool** · 29/10/2004, 19h48

Ok merci à vous je vais tester tout cela

**Macno** · 02/11/2004, 09h13

Salut à tous

La solution de argyronet fonctionne drolement bien !! Même si j'ai pas compris le principe du calcul du jour de pâques

. Donc c'était juste pour dire merci !!

A+

**argyronet** · 02/11/2004, 10h14

J'en suis ravi...

Peux tu clore le dossier stp ?

Argy

**Macno** · 02/11/2004, 10h28

Mais je ne suis pas l'auteur du message original, je ne peux donc rien clore....

**argyronet** · 02/11/2004, 10h42

Désolé, Macno, je n'ai pas fait attention.
Bien, je reprends, si djool est aussi satisfait que toi, qu'il veuille bien clore le dossier

Argy

**djool** · 03/11/2004, 18h02

Merci bcp cela marche super bien argyronet sur ce je clos le dossier

**tee_grandbois** · 05/11/2004, 00h03

Merci Argyronet

pour le code des jours fériés, cela fait plus de 10 ans que je développe avec access et je ne pensais pas qu'un tel algorithme existait ! (pour calculer les jours fériés je m'était toujours contenté de tables remplies tous les ans

).
Cependant, j'ai découvert une petite erreur sur la ligne ci-dessous :
JoursFeries(3) = CDate("08/01/" & anneeDate)
je pense qu'il s'agit du 8 mai, selon toute vraisemblance.

**MC2** · 05/11/2004, 00h43

Génial ! j'achète moi aussi !

Note : à priori pour le calcul du lundi de pâques (2004 par ex.), la fonction de Caféine (merci à toi aussi !) fonctionne et pas celle de Argyronet (pardon).
En remplaçant donc la fonction "JourDePaques" de Argyronet par celle de Caféine "fLundiPaques", il faut corriger dans la fonction "EstFerié", les 2 lignes :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
  joursFeries(10) = joursFeries(9) + 38 
  joursFeries(11) = joursFeries(9) + 49

Encore merci à tous les 2

**tee_grandbois** · 06/11/2004, 00h16

Bien vu, MC2, merci pour cette dernière précision.
au fait, quelqu'un connaitrait une astuce pour calculer les ponts

?

(Non... je plaisante !

)

Jours fériés

Access

Discussions similaires

Partager

Partager