Calcule entre 2 dates, sur des jours ouvrables

Télécharger le projet
Commenter

Description

Cette exemple permet selon la date de d'envoie dans le TextBox(text1.text) de retourner la date de reception dans TextBox (Text2.text) en fonction du nombres de jours ouvrables choisi dans le ConboBox(combox1).
Il rajoute les jours Non Ouvrables dans le resultat (Samedi,Dimanche, et jours fériés)
Ce code inclu une partie d'un source (jours ferié) trouvé sur ce site le reste est de moi !

Le code n'est pas optimisé (gestion des erreurs en cas de mauvaise saisie de la date de depart ect..)
Si une personne l'optimise elle serait sympa de m'envoyer le code modifié.

Source / Exemple : 


'---------------Dans la feuille

Option Explicit
Private Sub Combo1_Click() 'si ont selectionne quelque chose dans la liste
Listj = Val(Combo1.Text)    'retoune que les chiffre contenu dans la selection
If Listj = "0" Then
Listj = 0
Jourj = 0
        Text2.Text = Text1.Text 'si rien selectionné ont reaffiche la date qui est dans Text1.text (date courante ou entrée par l'utilisateur)
        Else
    Listj = Listj + 1 ' ont incremente de 2 jours d'office
        End If
    Call CalculeDate(Me)  ' Appel la procedure CalculeDate
End Sub
Private Sub Quitter_Click()
    Unload Me
    End
End Sub
Private Sub Form_Load()
    Call initialisation    'ont remplie le comboBox et initialise la date
End Sub

Private Sub Text1_Change()
mydate = Text1.Text    'tien compte de la date entree dans textbox1 comme nouvelle date de depart
End Sub

'---------------Dans le Module (bas)

Public mydate As String
Public Jo, M, An As Integer
Public BiSex As Integer
Public Listj As Integer
Public Jourj As Integer
Public NbOR, Epacte As Integer
Public Plune, Paques, Ascension, Pentecote As Date
Public Sub initialisation()
    Jo = 0
    mydate = Format(Date, "DD/MM/YYYY")
    Form1.Text1.Text = mydate    'TextBox1 prend la valeur de la date courante au format defini
    Form1.Combo1.AddItem ""
    For nbj = 2 To 30
    Form1.Combo1.AddItem nbj & " Jours"
Next nbj
End Sub
Public Sub CalculeDate(activeform As Form) 'activeform As Form sert a utiliser et retransmettre les valeurs dans la feuille active
       Jo = Format(mydate, "DD")
   M = Format(mydate, "MM")
  An = Format(mydate, "YYYY")
    'Ajout de X jours à la date
        For Jourj = Listj To 1 Step -1
Jo = Jo + 1
    
    BiSex = 0    'par défaut, année non bisextile
    If An \ 4 = An / 4 Then    '    'année divisible par 4
        If Right$(mydate, 2) <> "00" Or Right$(mydate, 3) = "000" Then    'lit les 3 derniers chiffres de l'annee
            BiSex = 1    'année bisextile
        End If
    End If
    If Jo > 28 + BiSex Then
        If M = 2 Then
            M = 3
            Jo = Jo - 28 - BiSex
        Else
            Select Case M
            Case 3, 6, 9, 11
                If Jo > 30 Then
                    M = M + 1
                    Jo = Jo - 30
                End If
            Case Else
                If Jo > 31 Then
                    M = M + 1
                    Jo = Jo - 31
                End If
            End Select
        End If
    End If
    If M > 12 Then
        An = An + 1
        M = M - 12
    End If
         If Weekday(Jo & "/" & M & "/" & An) = 7 Then 'Samedi vbSaturday =7
         'Beep
         Jo = Jo + 2
         activeform.Label4.Caption = " WeekDay Samedi(7) = " & Weekday(Jo & "/" & M & "/" & An)
         End If
activeform.Label4.Caption = " WeekDay Jour  = " & Weekday(Jo & "/" & M & "/" & An)

    If Jo = 1 And M = 1 Then Jo = (Jo + 1) And mgbox = " 1 novembre " '1 Janvier
    If Jo = 1 And M = 5 Then Jo = (Jo + 1) '1 Mai
    If Jo = 8 And M = 5 Then Jo = (Jo + 1) '8 Mai
    If Jo = 14 And M = 7 Then Jo = (Jo + 1) '14 Juillet
    If Jo = 15 And M = 8 Then Jo = (Jo + 1) '15 Août
    If Jo = 1 And M = 11 Then Jo = (Jo + 1) '1 Novembre
    If Jo = 11 And M = 11 Then Jo = (Jo + 1) '11 Novembre
    If Jo = 25 And M = 12 Then Jo = (Jo + 1) '25 Décembre
    'Verifie pour les fetes ? indique comme jours ferié
      NbOR = (An Mod 19) + 1
    Epacte = (11 * NbOR - (3 + Int((2 + Int(An / 100)) * 3 / 7))) Mod 30
    Plune = CDate("19/04/" & An) - ((Epacte + 6) Mod 30)

    If Epacte = 24 Then Plune = Plune - 1
    If Epacte = 25 And (An >= 1900 And An < 2200) Then Plune = Plune - 1

 Paques = Plune - Weekday(Plune) + vbMonday + 7    'Paques
    If Jo = Format(Paques, "DD") And M = Format(Paques, "MM") Then Jo = (Jo + 1)

    Ascension = Paques + 38    'Ascension
    If Jo = Format(Ascension, "DD") And M = Format(Ascension, "MM") Then Jo = (Jo + 1)

    Pentecote = Ascension + 11    'Pentecôte
    If Jo = Format(Pentecote, "DD") And M = Format(Pentecote, "MM") Then Jo = (Jo + 1)

 activeform.Text2.Text = Jo & "/" & M & "/" & An

Next Jourj
Jo = 0: Listj = 0 ' ont sort de la boucle et ont remet les valeurs a 0
activeform.Text2.Text = Format(activeform.Text2.Text, "dddd d mmmm YYYY")

End Sub

Conclusion :


Le zip est fourni.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (cs_claudetom)