Discussion :

[cjay974]

Bonjour a tous

j'ai enregistré la fonction EstFerie si dessous que j'ai trouver sur votre forum pour la vérification des 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
Function EstFerie(ByVal QuelleDate As Date) As Boolean
Dim anneeDate As Integer
Dim joursFeries(1 To 12) As Date
Dim I As Integer
  anneeDate = Year(QuelleDate)
 
  joursFeries(1) = DateSerial(anneeDate, 1, 1)
  joursFeries(2) = DateSerial(anneeDate, 5, 1)
  joursFeries(3) = DateSerial(anneeDate, 5, 8)
  joursFeries(4) = DateSerial(anneeDate, 7, 14)
  joursFeries(5) = DateSerial(anneeDate, 8, 15)
  joursFeries(6) = DateSerial(anneeDate, 11, 1)
  joursFeries(7) = DateSerial(anneeDate, 11, 11)
  joursFeries(8) = DateSerial(anneeDate, 12, 25)
  joursFeries(9) = DateSerial(anneeDate, 12, 20)
 
  joursFeries(10) = fLundiPaques(anneeDate)
  joursFeries(11) = joursFeries(10) + 38 ' Ascension = lundi de Pâques + 38
  joursFeries(12) = joursFeries(10) + 49 ' Lundi Pentecôte = lundi de Pâques + 49
 
  For I = 1 To 12
    If QuelleDate = joursFeries(I) Then
      EstFerie = True
      Exit For
    End If
  Next
End Function
 
Public 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
 
        ' Lundi de Pâques = Pâques + 1 jour
        fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
 
End Function

Dans un formulaire je crée un planning en saisissant "date de début" et "date de fin" que je boucle avec le code suivant : (ça c'est bon ... encore grace au forum)

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
If Me.INDISPO_DU <> "" Then
' Quelques variables
    Dim rst As DAO.Recordset
    Dim iteration As Long
'pour trouver le nombre de jour
    iteration = DateDiff("d", Me.INDISPO_DU, Me.INDISPO_AU)
' Ouvrir la table en lecture/écriture
    Set rst = CurrentDb.OpenRecordset("T_PLANNING", dbOpenDynaset)
' Boucler sur le nombre d'attestations demandées
    For I = 0 To iteration
' Créer un enregistrement dans la table
        rst.AddNew
' Alimenter les champs
        rst("DATES") = Me.INDISPO_DU + I
        rst("GROUPES") = Me.GROUPES
        rst("MATIERES_F") = Me.INDISPO_MOTIF
        rst("FORMATEURS") = Me.INDISPO_INTERVENANT
        rst("CONTENUS_F") = ""
        rst("AM/PM") = Me.INDISPO_AMPMJOUR
' Valider
        rst.Update
    Next
' Message fin
MsgBox "Enregistrements validés"
Me.INDISPO_INTERVENANT = ""
Me.INDISPO_DU = ""
Me.INDISPO_AU = ""
Me.INDISPO_AMPMJOUR = ""
Me.INDISPO_MOTIF = ""
Else
MsgBox "SAISIR DATES D'INDISPONIBILITE"
End If

je souhaite au moment de la création de chacune des dates vérifier si il y a des jours fériés.
si c'est le cas remplacer sur la ou les dates en question
rst("MATIERES_F") = Me.INDISPO_MOTIF
par
rst("MATIERES_F") = "Jours fériés"

merci par avance pour votre aide

amicalement

[Invité]

Bonjour si ça t'inspire: http://www.developpez.net/forums/d14...s/#post8011426

plus besoin d'un tableau d'identification des jour fériés! joursFeries(1) = DateSerial(anneeDate, 1, 1)

Code Jours fériés :

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
Function Ferier(UneDate As Long) As Boolean' Par défaut la fonction ne considère pas que les Dimanche de Pâques
' et de Pentecôte sont fériés
' il suffit de renseigner l'argument DimanchesOuiNon à True à l'appel de la fonction
' pour les considérer comme fériés
If Weekday(UneDate) = 1 Or Weekday(UneDate) = 7 Then Ferier = True: Exit Function
 
Dim JFF ' table des fériés fixes (jours)
Dim MFF ' table des fériés fixes (mois)
JFF = Array(1, 1, 8, 14, 15, 1, 11, 25)
MFF = Array(1, 5, 5, 7, 8, 11, 11, 12)
Dim J As Long
Ferier = False
' Recherche dans la table des jours fériés fixes
For J = 0 To 7
If Day(UneDate) = JFF(J) And Month(UneDate) = MFF(J) Then
Ferier = True
Exit Function
End If
Next J
Dim FM ' contient les dates des lundis de Paques
'FM = Array(38824, 39181, 39531, 39916, 40273, 40658, 41008, _
'41365, 41750, 42100, 42457, 42842, _
'43192, 43577, 43934, 44291, 44675, _
'45026, 45383, 45768, 46118, 46475, _
'46860, 47210, 47595)
 
FM = Paque(Year(UneDate))
' Recherche si la date est un lundi de paques
' ou jeudi de l'ascension
' ou lundi de pentecôte
'For J = 0 To 24 ' à changer si vous allez au delà de 2030
If (UneDate = FM) Or (UneDate = FM + 39) Or (UneDate = FM + 50) Then
Ferier = True
Exit Function
End If
' si DimanchesOuiNon est vrai
' on teste les dimanches de Pâques et Pentecote
 
 
If DimanchesOuiNon Then
If (UneDate = FM - 1) Or (UneDate = FM + 48) Then
Ferier = True
Exit Function
End If
End If
'Next J
End Function
Function Paque(Annee As Integer) As Date
Dim A, B, C, D, E, F, G, H, I, J, K, L, M, N, O
C = Annee - 1900
D = C Mod 19
E = (D * 7) + 1
F = Int(E / 19)
G = 11 * D - F + 4
H = G Mod 29
I = Int(C / 4)
J = C - H + I + 31
L = J Mod 7
K = J Mod 7
L = 25 - H - K
M = CDate("31/03/" & Annee)
Paque = M + L
End Function

Code :

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

1
2
3
4
5
6
rst("DATES") = Me.INDISPO_DU + I
rst("GROUPES") = Me.GROUPES
rst("MATIERES_F") = Me.INDISPO_MOTIF
rst("FORMATEURS") = Me.INDISPO_INTERVENANT
rst("CONTENUS_F") = Array(Me.INDISPO_MOTIF, "Jours fériés")(Abs(Ferier(CLng(rst("DATES")))))
rst("AM/PM") = Me.INDISPO_AMPMJOUR

[cjay974]

Bonjour dysorthographie

merci c'est nickel

bravo a ce site et longue vie a developpez.net

[User]

La fonction EstFerié est intéressante,

Il y en a une autre dans le même genre que j'avais trouvé sur un blog,
mais les blogs n'ont malheureusement pas une très grande visibilité.

Cdlt,