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.
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.