[Toutes versions] Ajouter X jours ouvré à une date [Résolu]

[DaD92]

Bonjour,

Je bosse sur une macro VBA Excel qui va tourné sur plusieurs PC et plusieurs version d'excel.
Auriez vous dans v
os bibliothèque un bout de code pour ajouter X nbres de jours ouvré à une date? je suppose qu'il faut une page nommée contenant toutes les dates fériés possible....

Merci d'avance si vous avez ça, ou des pistes de recherche.
DaD

[ZebreLoup]

Quand tu parles de jours ouvrés tu ne veux enlever que les WE ou aussi des jours fériés prédéfinis ?

[DaD92]

week end et jours fériés, oui...

[MarcelG]

Bonsoir,

Sujet fréquemment abordé.

Notamment la solution de mercatog pour 2 jours, qui peut s'adapter à mon avis :

mercatog + 2 jours ouvrés

Bon Week-End à tous.

[DaD92]

j'avais vu la fonction execl lab, mais je le voulais en code vba

J'ai parcouru l'autre de tes liens, et y'a bien ce que je cherche, mais j'arrive pas à l'utiliser. faut dire que je suis un nub

ça me semble fou de devoir créer 2 ou 3 fonction pour un truc basique comme ça....

Je souhaite juste afficher dans un userform la date du jour + 5 jours ouvré...

[DaD92]

Pour tester, j'essaye d'afficher mon résultat dans la cellule B1

Code :

Range("B1").Value = Format(Application.WorkDay(CDate("25/11/2011"), 5, fr), "dd/mm/yyyy")

Je ne sais pas trop ce qu'est censé être "fr"... le nombre de jour férié entre le 25/11/2011 et mon résultat?
comment je le calcul?

[DaD92]

J'ai bidouillé un truc avec du code trouvé sur le net :

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
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
 
Function CalculDateLivraison()
    Dim DateDuJour As Date
    Dim DatePlus5 As Date
    Dim NbJourOuvre
    Dim bAvecJFerie As Boolean
    Dim DatePlus5Ouvre As Date
 
    bAvecJFerie = True
 
    DateDuJour = CDate("8/08/2012")  'Format(Date, "dd/mm/yyyy")
    DatePlus5 = DateDuJour + 5
    DatePlus5Ouvre = DatePlus5
 
    NbJourOuvre = Work_Days(DateDuJour, DatePlus5, bAvecJFerie)
    'MsgBox NbJourOuvre
    If NbJourOuvre <> 5 Then
        Do While NbJourOuvre <> 5
 
 
        DatePlus5Ouvre = DatePlus5Ouvre + 1
        DatePlus5 = DatePlus5 + 1
        NbJourOuvre = Work_Days(DateDuJour, DatePlus5, bAvecJFerie)
        Loop
    End If
 
    'MsgBox "Date du jour : " & DateDuJour & " .Date plus 5j : " & DatePlus5 & " .Nombre de jour ouvré : " & NbJourOuvre & " .Date plus 5j ouvré " & DatePlus5Ouvre
 
End Function
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 Paques + 38
  joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Paques + 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 +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 = Paques + 1 jour
        fLundiPaques = DateAdd("d", 1, (Lj & "/" & Lm & "/" & Iyear))
 
End Function

au cas où d'autres aurait le même soucis...