[VBA-E]Ajouter jours ouvrés -> NB.Jours.Ouvres, Serie.Jours.Ouvres

[ouskel'n'or]

Comment obtenir la date du jour + n jours ouvrés, ou utilisation de SERIE.JOUR.OUVRE dans Excel :
L'aide en ligne précise :

Important : Les dates doivent être entrées en utilisant la fonction DATE, ou sous la forme de résultats d'autres formules ou fonctions. Des problèmes peuvent survenir si les dates sont entrées sous forme de texte.

En cas de saisie manuelle de la date, la formule ne fonctionnerait donc pas.
On peut pallier le problème en compliquant un peu les choses...
...
Charger la macro complémentaire "Utilitaire d'analyse" :
Dans Excel -> Cocher l'Utilitaire d'analyse VBA dans les macros complémentaires :
Outils -> Macros complémentaires -> Valider Utilitaire d'analyse VBA
...
ou par soft :

Code :

Application.AddIns.Add("C:\Program Files\Microsoft Office\Office10\Macrolib\Analyse\ANALYS32.XLL").Installed = True

...A vous de trouver le bon emplacement du fichier...
...
La solution consiste à formater le résultat d'une formule Excel :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
Sub JoursOuvresAjouterExcel()
Dim LaDate As Double, Formule As String
    LaDate = CDbl(CDate("16/03/2007"))
    'ou
    LaDate = CDbl(Cells(2, 1))
    'ou
    LaDate = CDbl(Date)
    Formule = "=SERIE.JOUR.OUVRE(" & LaDate & ",3)"
    Range("A3")Formula = Formule
    Application.Calculate
    Range("A3") = CDate(Format(Range("A3"), "dd/mm/yyyy"))
End Sub

...
Pour obtenir le même résultat avec VBA (avec l'assistance efficace de bbil)
...
Charger la macro complémentaire "Utilitaire d'analyse" (voir plus haut)
puis,
Dans l'Editeur VB -> Ajouter atpvbaen.xls en référence au projet :
Outils - Références -> Valider atpvbaen.xls

Puis utiliser ce code

Code :

1
2
3
4
5
6
7
8
9
10
Sub JoursOuvresAjouterVBA()
Dim LaDate As Double, NewDate As Date
    LaDate = CDbl(CDate("16/03/2007"))
    'ou
    LaDate = CDbl(Cells(2, 1))
    'ou
    LaDate = CDbl(Date)
    NewDate = Format(Workday(LaDate, 3), "dd/mm/yyyy")
    MsgBox NewDate
End Sub

Où Workday(Ladate, 3) ajoute 3 jours à la date, + les éventuels jours calendaires non ouvrés, s'ils se trouvent dans la plage ajoutée
Toute info complémentaire est la bienvenue

[illight]

Tiens pour faire mumuse et calculer le nombre de jours ouvrés entre 2 dates, j'avais créé cette fonction :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Function WeeklyDays(DateDepart As Date, DateFin As Date) As Long
Dim d As Date
Dim j As Long
Dim n As Long
n = 0
For d = DateDepart To DateFin
    If Weekday(d) = vbSaturday Then
        n = n - 1
    ElseIf Weekday(d) = vbSunday Then
        n = n - 1
    Else
        For j = 1 To Feuil1.Range("A1").End(xlDown).Row
            If d = Feuil1.Cells(j, 1).Value Then
                n = n - 1
            End If
        Next j
    End If
Next d
WeeklyDays = n
End Function

qui permet de calculer le nombre de jours à enlever à une différence de date. On peut surement la simplifier cette fonction. Mais elle s'utilise comme suit :

Code :

NbreJoursOuvres = DateDiff("d", "23/04/2007", "03/05/2007") + WeeklyDays(DateValue("23/04/2007"), DateValue("03/05/2007"))

Un peu barbare mais ça marche bien

Petite précision : sur la feuil1, on a listé sur la première colonne tous les jours fériés existants

[ouskel'n'or]

Pour connaître le nombre de jours ouvrés entre deux dates, on peut aussi ajouter les jours ouvrés

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub NbreJourOuvres()
Dim DateDebut As Date
Dim DateFin As Date
    DateDebut = CDbl(DateValue("03/04/2007"))
    DateFin = CDbl(DateValue("03/05/2007"))
    MsgBox NBJoursOuvres(DateDebut, DateFin)
End Sub
 
Function NBJoursOuvres(DateDebut, DateFin)
Dim i As Long
    For i = DateDebut To DateFin
        If Weekday(CDate(i)) <> 1 And Weekday(CDate(i)) <> 7 Then _
            NBJoursOuvres = NBJoursOuvres + 1
    Next
End Function

A qui le tour ?

[ouskel'n'or]

Autre version pour la fonction

Code :

1
2
3
4
5
6
7
Function NBJoursOuvres(DateDebut, DateFin)
Dim i As Long
    For i = DateDebut To DateFin
         NBJoursOuvres = NBJoursOuvres + (Weekday(CDate(i)) <> 1 And _
                           Weekday(CDate(i)) <> 7) * True
    Next
End Function