Discussion :

[CtrlCmpt]

Bonjour,

Je sollicite votre aide pour un petit souci que je rencontre.

J'ai une Macro qui me permet de faire des calculs de jours (J+1, J+2, J+3 ....) à partir de la date du dernier jour ouvrable du mois précédent.

Cette Macro prends en compte les week-end mais j'aimerai aussi qu'elle prend en compte les jours fériés aussi.

J'ai créé une feuille que j'ai nommé "Fériés" comme on m'a indiqué, mais je ne sais pas comment intégrer ça à la Macro.

Pouvez-vous m'aider SVP ?

Fichier en PJ.

voici la Macro que j'ai actuellement:

Code :

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

1
2
3
4
5
6
7
Sub Macro1()
Dim NomFic As String
NomFic = ThisWorkbook.Name
ThisWorkbook.Names.Add "DateRef", "=SERIE.JOUR.OUVRE(SERIE.JOUR.OUVRE(DATE(" _
   & Mid$(NomFic, Len(NomFic) - 7, 4) & "," & Mid$(NomFic, Len(NomFic) - 9, 2) + 1 & ",0),1),-1)"
Feuil1.[K6:K83].FormulaR1C1 = "=IF(RC10<>"""",SERIE.JOUR.OUVRE(DateRef,SUBSTITUTE(RC10,""J"",""""),),"""")"
End Sub

Cordialement

[Invité]

Bonjour,
Test ce fichier Excel ; pas besoin d’une feuille jour fériés la macro calcule tout.
De plus, j’ai mis la façon de l’utiliser dans Excel.

[MarcelG]

Bonjour CtrlCmpt et Robert, Bonjour le Forum,

J'avais récupéré le code d'une fonction retounant une valeur boléenne relative au fait qu'un jour soit férié ou non.

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
50
51
52
53
Function Is_Férié(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
      Is_Férié = 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
 
Public Function HeuresTravail(date1 As Date, heure1 As Long, date2 As Date, heure2 As Long) As Long
diff = (Jours_Travail(date1, date2) - 1) * 10 - (heure1 - heure2)
HeuresTravail = diff
End Function

Et partant de là, le code d'une fonction calculant le nombre de jours travaillés (non fériés et non week-end) entre 2 dates.

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
Function Jours_Travail(BegDate As Variant, EndDate As Variant, _
                   Optional bAvecJFerie As Boolean = True) As Variant
    Dim ladate As Date
 
On Error GoTo Jours_Travail_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
 
    ladate = BegDate
    Jours_Travail = 0
    While ladate <= EndDate
        If DatePart("w", ladate, vbMonday) < 6 And IIf(bAvecJFerie, Not Is_Férié(ladate), True) Then
            Jours_Travail = Jours_Travail + 1
        End If
        ladate = DateAdd("d", 1, ladate)
    Wend
    Exit Function
 
Jours_Travail_Error:
    Select Case Err.Number
        Case vbObjectError + 1: Jours_Travail = "Les 2 dates sont obligatoires."
        Case vbObjectError + 2: Jours_Travail = "Format de date incorrect."
        Case vbObjectError + 3: Jours_Travail = "La date de fin doit être postérieure à la date de début."
        Case Else: Jours_Travail = Err.Description
    End Select
End Function

J'ai donc pu créer la fonction qui consiste à ajouter un nombre de jours à une date donnée en tenant compte des seuls jours ouvrés.

C'est la fonction qui semble t'intéresser.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Function FinalDate(date_début As Date, nbjours As Integer, _
                   Optional Fériés As Boolean = True) As Date
 
    Dim ladate As Date
 
    ladate = CDate(date_début) + 1
 
    While Jours_Travail(date_début, ladate, Fériés) < nbjours
        ladate = DateAdd("d", 1, ladate)
    Wend
 
    FinalDate = ladate
 
End Function

La formule d'une cellule

=FinalDate("31/10/13";10;VRAI)

te retournera

vendredi 15 novembre 2013

Certes, il doit y avoir plus simple. Mais je pense qu'il est utile de conserver ce type de fonctions.

Enfin, un tutoriel à lire absolument : celui de Didier Gonard sur les dates

Les dates par Didier Gonard

[CtrlCmpt]

Bonjour MarcelG, rdurupt,

Merci beaucoup pour votre aide.

J'avoue que je suis nul en Macro, pouvez-vous m'indiquer SVP sur la base de mon code où je peux rajouter votre proposition ?

Cordialement

[MarcelG]

Salut à toi,

(Nous avons tous été nuls à un moment de notre vie, et je suis encore loin d'un Patrick Toulon, d'un Jérôme et d'un Mercatog)

Tout d'abord, tu comprends le code dans ses grandes lignes, surtout dan les 2 dernières fonctions.
Tu insères ensuite un module dans ton éditeur VBE et tu recopies tous les développements que je t'ai indiqués.

Cela fait, une fonction personnelle s'utilise comme toute autre fonction. (Voir le tutoriel de Sylkiroad)
Comme je l'ai signalé, tu peux écrire la fonction FinalDate dans n'importe quelle cellule de tes feuilles de travail, à condition de respecter l'argumentation.

Tu peux aussi l'intégrer dans un code. Pour cela, aide-toi de l'enregistreur.
(à cause de ces f... doubles cotes)

Et surtout, tu reviens si nécessaire.

Salut,

En complément et illustration

Code :

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

1
2
3
4
5
6
Sub Macro1()
With Range("B15")
   .FormulaR1C1 = "=finaldate(""31/10/13"",10,TRUE)"
   .Value = .Value
End With
End Sub

L'astuce (je ne me rappelle jamais quel en est l'auteur)

Code :

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

 .Value = .Value

revient à un collage spécial valeurs.