IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

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


Sujet :

Macros et VBA Excel

  1. #1
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 543
    Points
    15 543
    Par défaut [VBA-E]Ajouter jours ouvrés -> NB.Jours.Ouvres, Serie.Jours.Ouvres
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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

  2. #2
    Expert confirmé Avatar de illight
    Homme Profil pro
    Analyste décisionnel
    Inscrit en
    Septembre 2005
    Messages
    2 338
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Analyste décisionnel
    Secteur : Service public

    Informations forums :
    Inscription : Septembre 2005
    Messages : 2 338
    Points : 4 295
    Points
    4 295
    Par défaut
    Tiens pour faire mumuse et calculer le nombre de jours ouvrés entre 2 dates, j'avais créé cette fonction :

    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
     
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    1. Avant de poster, et http://www.developpez.com/sources/
    2. Lors du post, n'oubliez pas, si besoin les balises CODE => voir ici pour l'utilisation
    3. N'oubliez pas le
    4. N'oubliez pas le si la réponse vous a été utile !

  3. #3
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 543
    Points
    15 543
    Par défaut Datediff en jours ouvrés
    Pour connaître le nombre de jours ouvrés entre deux dates, on peut aussi ajouter les jours ouvrés
    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
    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 ?

  4. #4
    Inactif  
    Avatar de ouskel'n'or
    Profil pro
    Inscrit en
    Février 2005
    Messages
    12 464
    Détails du profil
    Informations personnelles :
    Localisation : France

    Informations forums :
    Inscription : Février 2005
    Messages : 12 464
    Points : 15 543
    Points
    15 543
    Par défaut
    Autre version pour la fonction
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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

Discussions similaires

  1. [JpGraph] Gantt : ajouter de la couleur selon les horaires (nuit/jour) sur le fond
    Par lukeabate dans le forum Bibliothèques et frameworks
    Réponses: 0
    Dernier message: 16/03/2012, 17h03
  2. Réponses: 3
    Dernier message: 13/10/2011, 13h28
  3. [XL-2003] Fonction SERIE.JOUR.OUVRE() récupérer la date du vendredi
    Par azertix dans le forum Excel
    Réponses: 11
    Dernier message: 22/03/2011, 09h53
  4. SERIE.JOUR.OUVRE excel 2003
    Par jeanpierreco dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 22/01/2011, 13h41
  5. [VBA-E]Problème de récupération du n° de semaine du jour
    Par isa21493 dans le forum Macros et VBA Excel
    Réponses: 4
    Dernier message: 23/02/2006, 14h33

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo