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

VBA Access Discussion :

Calcul de jours ouvres


Sujet :

VBA Access

  1. #1
    Membre régulier Avatar de omen123
    Homme Profil pro
    Technicien Help Desk
    Inscrit en
    Septembre 2015
    Messages
    340
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : Allemagne

    Informations professionnelles :
    Activité : Technicien Help Desk
    Secteur : Associations - ONG

    Informations forums :
    Inscription : Septembre 2015
    Messages : 340
    Points : 100
    Points
    100
    Par défaut Calcul de jours ouvres
    bonjour les amis ,

    dans une ancienne base j'avais mis un module pour le calcul des délais sans compter les samedis et dimanche. Le calcul était exacte , après quelque temps j'ai refait toute la base depuis le début et j'ai copié le même module , a ma surprise le module ne permet plus le bon calcul .

    pouvez vous m'orienter sur la cause svp (sachat que je l'ai copié et je n'ai rien changé ) , ci -après le module :

    merci d'avance.

    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
     
    Option Compare Database
     
    Function Work_Days(BegDate As Variant, EndDate As Variant, _
                       Optional bAvecJFerie As Boolean = False) 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
    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
    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 Pâques + 38
      joursFeries(11) = joursFeries(9) + 49 ' Lundi Pentecôte = lundi de Pâques + 49
     
      For i = 1 To 11
        If QuelleDate = joursFeries(i) Then
          EstFerie = True
          Exit For
        End If
      Next
    End Function
    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
    Private Function fLundiPaques(ByVal Iyear As Integer) As Date
            ' Adapté de plusieurs 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
    Aux incompétents je dis merci ,grâce à vous je progresse !

  2. #2
    Expert éminent sénior
    Avatar de tee_grandbois
    Homme Profil pro
    retraité
    Inscrit en
    Novembre 2004
    Messages
    8 621
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 67
    Localisation : France, Yvelines (Île de France)

    Informations professionnelles :
    Activité : retraité

    Informations forums :
    Inscription : Novembre 2004
    Messages : 8 621
    Points : 14 577
    Points
    14 577
    Par défaut
    bonjour,
    si le code est exactement le même, il ne peut pas être mis en cause. Il peut s'agir de paramètres différents (Access ou régionaux). Et avoir aussi un exemple concret (résultat avant/résultat après) pourrait aider un peu ...
    Quand on est derrière l'écran on n'a aucun clavier sous les mains ...
    ah non ? donc devant l'écran c'est la connectique ?

  3. #3
    Membre régulier Avatar de omen123
    Homme Profil pro
    Technicien Help Desk
    Inscrit en
    Septembre 2015
    Messages
    340
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 42
    Localisation : Allemagne

    Informations professionnelles :
    Activité : Technicien Help Desk
    Secteur : Associations - ONG

    Informations forums :
    Inscription : Septembre 2015
    Messages : 340
    Points : 100
    Points
    100
    Par défaut
    bonjour

    merci tee ,j''ai trouvé la solution , c etait un probleme de requete .
    Aux incompétents je dis merci ,grâce à vous je progresse !

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. calcul de jours ouvrés entre 2 dates
    Par pinpin_pinpin dans le forum MS SQL Server
    Réponses: 1
    Dernier message: 20/11/2009, 23h24
  2. Calcul de jours ouvrés entre 2 dates
    Par pinpin_pinpin dans le forum Langage SQL
    Réponses: 1
    Dernier message: 20/11/2009, 21h33
  3. [calcul] dernier jour ouvré du mois
    Par xolias dans le forum Oracle
    Réponses: 5
    Dernier message: 26/02/2008, 17h26
  4. Fonction de calcul de jours ouvrés
    Par jeanjean0403 dans le forum VB 6 et antérieur
    Réponses: 4
    Dernier message: 03/01/2008, 11h04
  5. Réponses: 3
    Dernier message: 28/09/2007, 12h44

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