bonjour les amis ,
dans une ancienne base j'avais mis un module pour le calcul des délais sans compter les samedis et dimanche. Le calcul était exacte , après quelque temps j'ai refait toute la base depuis le début et j'ai copié le même module , a ma surprise le module ne permet plus le bon calcul .
pouvez vous m'orienter sur la cause svp (sachat que je l'ai copié et je n'ai rien changé ) , ci -après le module :
merci d'avance.
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 Option Compare Database Function Work_Days(BegDate As Variant, EndDate As Variant, _ Optional bAvecJFerie As Boolean = False) 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
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 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
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 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
Partager