Rechercher le nombre de jours ouvrés entre deux dates ( le code est il bon ? )

Version imprimable

Bonjour à tous ,

Je souhaite connaitre le nombre de jours ouvrés entre 2 dates "La date du jour" - "date pegged" .
J'ai trouvé un code sur le net mais je ne sais pas l'utiliser et est ce la bonne ?
Je vous remercie tous pour votre aide .

Merci Cordialement
eRIC

Code:

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
Function Work_Days(BegDate As Variant, EndDate As Variant) As Integer
 
 Dim WholeWeeks As Variant
 Dim DateCnt As Variant
 Dim EndDays As Integer
 
 On Error GoTo Err_Work_Days
 
 BegDate = DateValue(BegDate)
 EndDate = DateValue(EndDate)
 WholeWeeks = DateDiff("w", BegDate, EndDate)
 DateCnt = DateAdd("ww", WholeWeeks, BegDate)
 EndDays = 0
 
 Do While DateCnt <= EndDate
 If Format(DateCnt, "ddd") <> "Sun" And _
 Format(DateCnt, "ddd") <> "Sat" Then
 EndDays = EndDays + 1
 End If
 DateCnt = DateAdd("d", 1, DateCnt)
 Loop
 
 Work_Days = WholeWeeks * 5 + EndDays
 
Exit Function
 
 Err_Work_Days:
 
 ' If either BegDate or EndDate is Null, return a zero
 ' to indicate that no workdays passed between the two dates.
 
 If Err.Number = 94 Then
 Work_Days = 0
 Exit Function
 Else
' If some other error occurs, provide a message.
 MsgBox "Error " &amp; Err.Number &amp; ": " &amp; Err.Description
 End If
 
End Function

15/04/2018, 16h42
hyperion13

Salut,
Pourquoi ne le serait-elle pas ? Elle est là
Copiez la formule dans un Module et il vous suffira de créer une requête et de générer la fonction personnalisée Work_days
Vous pourrez ainsi vérifier si elle est ou non fonctionnelle.

EDIT : 16.04.2018 : elle gère les jours fériés en plus

Rechercher le nombre de jours ouvrés entre deux dates ( le code est il bon ? )

Bonjour à tous ,

j'ai essayé depuis des jours toutes les possibilités . impossible de faire fonctionner le code sur ma requête. ladatedujour (correspond à date du jour) et la datepegged (correspond à la date de la commande) et je souhaite connaitre la différence de jours entre les 2 dates sans les week end et jours fériés .

Voici les codes que j'ai mis sur la requête ===> datepegged et aprés sur un autre champ Ladatedujour: Date() =====> ces 2 codes fonctionnent parfaitement . Maintenant je souhaite connaitre la différence de jours entre ces 2 dates via la requête . J'ai mis sur ma requête le nom de la fonction nbre : ([Work_Days]) et cela ne fonctionne pas

Merci pour votre aide
Cordialement
Eric

Code:

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
Function Work_Days(Ladatedujour As Variant, datepegged As Variant, _
                   Optional bAvecJFerie As Boolean = True) As Variant
    Dim dt As Date
 
On Error GoTo Work_Days_Error
    If IsNull(Ladatedujour) Or IsNull(datepegged) Then Err.Raise vbObjectError + 1
    If Not IsDate(Ladatedujour) Or Not IsDate(datepegged) Then Err.Raise vbObjectError + 2
    If Ladatedujour > datepegged Then Err.Raise vbObjectError + 3
 
    dt = Ladatedujour 
    Work_Days = 0
    While dt <= datepegged
        If DatePart("w", dt, vbMonday) < 6 And IIf(bAvecJFerie, Not EstFerie(dt), True) Then
            Work_Days = Work_Days + 1
        End If
        dt = DateAdd("d", 1, dt)
    Wend
    Exit Function
 
Work_Days_Error:
    Select Case Err.Number
        Case vbObjectError + 1: Work_Days = "Les 2 dates sont obligatoires."
        Case vbObjectError + 2: Work_Days = "Format de date incorrect."
        Case vbObjectError + 3: Work_Days = "La date de fin doit être postérieure à la date de début."
        Case Else: Work_Days = Err.Description
    End Select
End Function
 
 
Function EstFerie(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) = 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) = fLundiPaques(anneeDate)
  joursFeries(10) = joursFeries(9) + 38 ' Ascension = lundi de Pâques + 38
  joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Pâques + 49
 
  For i = 1 To 11
    If QuelleDate = joursFeries(i) Then
      EstFerie = True
      Exit For
    End If
  Next
End Function
 
Private Function fLundiPaques(ByVal Iyear As Integer) As Date
        ' Adapté de plusieurs 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 = Paques + 1 jour
        fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
 
End Function

Merci

08/05/2018, 20h11
Jean-Philippe André

Salut,

quelle est la requete sql stp ?

Citation:

cela ne fonctionne pas

Certes, mais encore ? Un message d'erreur ? Un résultat faux ? Obiwan Kenobi ?

Par défaut Rechercher le nombre de jours ouvrés entre deux dates ( le code est il bon ? )

Bonjour ,

Je suis parti du code VBA ci dessous puis j'ai mis dans la requete sql

Code:

datepegged

Code:

Ladatedujour: Date()

ça fonctionne bien et après message d'erreur requête sql sur le dernier via le code VBA

Code:

Work_Days : ([datepegged] ; ([ladatedujour])

Ou ai je fait l'erreur ?

Merci pour votre aide

Cordialement
Eric

Code:

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
Function Work_Days(BegDate As Variant, EndDate As Variant, _
                   Optional bAvecJFerie As Boolean = True) As Variant
    Dim dt As Date
 
On Error GoTo Work_Days_Error
    If IsNull(BegDate) Or IsNull(EndDate) Then Err.Raise vbObjectError + 1
    If Not IsDate(BegDate) Or Not IsDate(EndDate) Then Err.Raise vbObjectError + 2
    If BegDate > EndDate Then Err.Raise vbObjectError + 3
 
    dt = BegDate
    Work_Days = 0
    While dt <= EndDate
        If DatePart("w", dt, vbMonday) < 6 And IIf(bAvecJFerie, Not EstFerie(dt), True) Then
            Work_Days = Work_Days + 1
        End If
        dt = DateAdd("d", 1, dt)
    Wend
    Exit Function
 
Work_Days_Error:
    Select Case Err.Number
        Case vbObjectError + 1: Work_Days = "Les 2 dates sont obligatoires."
        Case vbObjectError + 2: Work_Days = "Format de date incorrect."
        Case vbObjectError + 3: Work_Days = "La date de fin doit être postérieure à la date de début."
        Case Else: Work_Days = Err.Description
    End Select
End Function
 
 
Function EstFerie(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) = 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) = fLundiPaques(anneeDate)
  joursFeries(10) = joursFeries(9) + 38 ' Ascension = lundi de Pâques + 38
  joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Pâques + 49
 
  For i = 1 To 11
    If QuelleDate = joursFeries(i) Then
      EstFerie = True
      Exit For
    End If
  Next
End Function
 
Private Function fLundiPaques(ByVal Iyear As Integer) As Date
        ' Adapté de plusieurs 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 = Paques + 1 jour
        fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
 
End Func

08/05/2018, 21h01
Jean-Philippe André

Le SQL de ta requete stp :)

Re-Bonjour,

Voici le code sql
les 2 derniers champs de sql ne fonctionnent pas (le dernier , je fais appelle à VBA)

Merci beaucoup pour votre aide
Cordialement
Eric

Code:

1
2
3
SELECT Sheet1.[Pegged Quantity], Sheet1.Points, Sheet1.Name, Sheet1.City, Sheet1.[Ship To Party], Sheet1.[Sales Organization], Sheet1.Choose, Sheet1.[Purchase order no#], Sheet1.[Order Quantity], Sheet1.[Confirmed Quantity], Sheet1.[Sales Document], Sheet1.[Sales Document Item], Sheet1.[Points per line (Pegged)], Sheet1.Description, Sheet1.[Requested deliv#date], Sheet1.[Delivery Date], Sheet1.[Arrival time], Sheet1.[Delivery Block Header], Sheet1.[Delivery Block Sched# Line], Sheet1.[Tail Lift], Sheet1.Pallets, Sheet1.[Gross weight], Sheet1.Material, Sheet1.[Telephone 1], Sheet1.[Postal Code], Sheet1.[Purchase order no#1], Sheet1.[Document Date], [Delivery Block Header] & +[Delivery Block Sched# Line] AS block, Sheet1.datepegged, Format([datepegged],"\ mmmm") AS [Mois pegged], Date() AS Ladatedujour, DateDiff("j",[Document Date],[datepegged]) AS jourss, DateDiff(" j",[Document Date],Now()) AS [Clients depuis], [Work_Days] AS VBA
FROM Sheet1
WHERE (((Sheet1.[Pegged Quantity])>0) AND (([Delivery Block Header] & +[Delivery Block Sched# Line]) Is Not Null));

08/05/2018, 22h38
CIRE3

Est ce le bon code VBA ? comment appeler la fonction via access ?

Bonjour,

En fait j'ai plus besoin du champs qui fait appelle à VBA car il supprime les week end et jours fériés
mais je dois faire une bêtise quand j'appelle la requête via VBA ? mais ou ?

Comment générer la fonction personnalisée Work_days VBA dans Access via requête ?

J'ai essayé aussi le code ci dessous et ça fonctionne bien maintenant car il fallait mette un D (et non j) dans la requête

Code:

nbrejours: DiffDate("d";[Document Date];Maintenant())

Merci pour votre aide
Cordialement
Eric
09/05/2018, 15h23
Jean-Philippe André

Salut,

si on limite l'analyse aux deux derniers champs

Code:

DateDiff(" j",[Document Date],Now()) AS [Clients depuis], [Work_Days] AS VBA

on peut constater une espace en trop avant le j pour ton premier champs, et lorsque tu fais appelle à une fonction il faut lui passer les parametres, ici les champs

Cela se corrigera donc en

Code:

DateDiff("j",[Document Date],Now()) AS [Clients depuis], Work_Days([datepegged],Date()) AS VBA

à l'erreur d'adaptation près.
13/05/2018, 17h15
CIRE3

Bonjour à tous,

Super je viens de réussir via le champs de la requête

Code:

nbresjur: Work_Days([datepegged];Date())

Merci beaucoup pour votre aide :

Cordialement
Eric