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

Ajouter X jours ouvré à une date

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

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

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

jours ouvrés

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.

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é...

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?

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...