Probleme de mise a jour date

[Résolu]
Signaler
Messages postés
38
Date d'inscription
mercredi 11 mars 2009
Statut
Membre
Dernière intervention
1 mars 2010
-
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
-
bonjour voila le code mais
Private Function IsFerie(Date_testee As Date) As Boolean
    Dim JJ, AA, MM As Integer
    Dim NbOr, Epacte As Integer
    Dim PLune, Paques, Ascension, Pentecote As Date
       If WeekDay(Date_testee, vbMonday) 6 Or WeekDay(Date_testee, vbMonday) 7 Then IsFerie = True: Exit Function


    JJ = Day(Date_testee)
    MM = Month(Date_testee)
    AA = Year(Date_testee)    If JJ 1 And MM 1 Then IsFerie = True: Exit Function '1 Janvier    If JJ 10 And MM 4 Then IsFerie = True: Exit Function ' 10 avril vendredi saint    If JJ 1 And MM 5 Then IsFerie = True: Exit Function '1 Mai    If JJ 8 And MM 5 Then IsFerie = True: Exit Function '8 Mai    If JJ 14 And MM 7 Then IsFerie = True: Exit Function '14 Juillet    If JJ 15 And MM 8 Then IsFerie = True: Exit Function '15 Août    If JJ 1 And MM 11 Then IsFerie = True: Exit Function '1 Novembre    If JJ 11 And MM 11 Then IsFerie = True: Exit Function '11 Novembre    If JJ 25 And MM 12 Then IsFerie = True: Exit Function '25 Décembre
    NbOr = (AA Mod 19) + 1
    Epacte = (11 * NbOr - (3 + Int((2 + Int(AA / 100)) * 3 / 7))) Mod 30
    PLune = DateSerial(AA, 4, 19) - ((Epacte + 6) Mod 30)    If Epacte 24 Then PLune PLune - 1
    If Epacte = 25 And (AA >= 1900 And AA < 2000) Then PLune = PLune - 1
    Paques = PLune - WeekDay(PLune) + vbMonday + 7 'Paques    If JJ Day(Paques) And MM Month(Paques) Then IsFerie = True: Exit Function
    Ascension = Paques + 38 'Ascension    If JJ Day(Ascension) And MM Month(Ascension) Then IsFerie = True: Exit Function
    Pentecote = Ascension + 11 'Pentecote    If JJ Day(Pentecote) And MM Month(Pentecote) Then IsFerie = True: Exit Function
    IsFerie = False
End Function


Function JPlusNbJour(Date_testee As Date, NbJour As Integer)
Dim DateCalc As Date, SamDim As Integer


DateCalc = DateAdd("w", 1, Date_testee) 'Voir si sous 97 il ne faut remplacer d par j


If IsFerie(DateCalc) = True Then
    While IsFerie(DateCalc) = True
        DateCalc = DateAdd("w", 1, DateCalc)  'Voir si sous 97 il ne faut remplacer d par j
  
    Wend
    JPlusNbJour = DateCalc
Else
    JPlusNbJour = DateCalc
End If


End Function


Function JPlusNbJour1(Date_testee As Date, NbJour As Integer)
Dim DateCalc1 As Date, SamDim As Integer


DateCalc1 = DateAdd("w", 3, Date_testee) 'Voir si sous 97 il ne faut remplacer d par j


If IsFerie(DateCalc1) = True Then
    While IsFerie(DateCalc1) = True
        DateCalc1 = DateAdd("w", 3, DateCalc1) 'Voir si sous 97 il ne faut remplacer d par j
  
    Wend
    JPlusNbJour1 = DateCalc1
Else
    JPlusNbJour1 = DateCalc1
End If


End Function
Private Sub date_enregistrement_AfterUpdate() 'A mettre sur "apres mise a jour" du controle date_enregistrement
    datesaisie = JPlusNbJour(date_enregistrement, 1)
    date_valeur_BDF = JPlusNbJour(datesaisie, 1)
  datej3 = JPlusNbJour1(datesaisie, 3)
voila mes lignes de commande les date se mette a jour du lundi au mercredi et le vendredi parcontre le jeudi il ne veux pas appliquer la formule suivante  datej3 = JPlusNbJour1(datesaisie, 3)
merci pour votre aide




iblis

21 réponses

Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
si date_enregistrement est le 26/03/2009 (jeudi)

datesaisie = JPlusNbJour(date_enregistrement, 1)
date_valeur_BDF = JPlusNbJour(datesaisie, 1)
datej3 = JPlusNbJour1(datesaisie, 3)

que souhaites tu obtenir dans les trois autres valeurs ?
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
ok.

ma fonction DateAdd donne bien ces résultats :

Public Function DateAdd(Interval As String, Number As Double, Date1 As Variant) As Variant
Dim nStep As Integer
Dim nCount As Long
If StrComp(Interval, "WD", vbTextCompare) Then
DateAdd = VBA.DateAdd(Interval, Number, Date1)
Else
nStep = Sgn(Number)
If nStep Then
nCount = Abs(Number)
DateAdd = Date1 + nStep
Do While nCount
If Not IsFerie(CDate(DateAdd)) Then
nCount = nCount - 1
End If
If nCount Then
DateAdd = DateAdd + nStep
End If
Loop
Else
DateAdd = Date1
End If
End If
End Function


au lieu de faire DateAdd("D" ... pour ajouter n jours,
j'ai ajouté en fait l'intervalle "WD" : working day
permettant d'ajouter un nombre donné de jours ouvrés a une date.


et le code de test:

Private Sub Form_Load()
Dim date_enregistrement As Date
Dim datesaisie As Date
Dim date_valeur_BDF As Date
Dim datej3 As Date

date_enregistrement = #3/26/2009#

datesaisie = DateAdd("WD", 1, date_enregistrement)
date_valeur_BDF = DateAdd("WD", 1, datesaisie)
datej3 = DateAdd("WD", 3, datesaisie)

Stop
End Sub


me donne bien les bonnes dates.

NB. j'ai modifié mon DateAdd pour utiliser ta focntion permettant de déterminer si un jour est férié.
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
If IsFerie(DateCalc1) = True Then
While IsFerie(DateCalc1) = True
...
Wend
End If

pas utile, ton IF.


ici :
Dim PLune, Paques, Ascension, Pentecote As Date
PLune, Paques, Ascension sont des Variant et non des Date


Pas compris quelle est la vraie question ...


tu peux te fier a mes fonctions de calcul de date dispo ici:

http://www.codyx.org/snippet_jours-feries-dimanche_355.aspx#1842
Messages postés
38
Date d'inscription
mercredi 11 mars 2009
Statut
Membre
Dernière intervention
1 mars 2010

le code fonction, mais il bug juste le jeudi et je n'arrive pas a savoir pourquoi

le jeudi il n'arrive pas a passer le week pour la fonction j+3
merci

iblis
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
? formatdatetime(JPlusNbJour1(#03/25/2009#, 3), vbLongDate)
mardi 31 mars 2009

Pourquoi ne tombe je pas sur le Lundi ?
Messages postés
38
Date d'inscription
mercredi 11 mars 2009
Statut
Membre
Dernière intervention
1 mars 2010

tres bonne question ?
le gros pb c'est avec le J+3 et la je comprend pas car le j+1 fonction tres bien

iblis
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
résumons, si tu le veux bien.

Pourquoi avoir deux fonctions assez similaires :

JPlusNbJour et JPlusNbJour1 ?

pourquoi ces fonction n'exploitent pas le parametre NbJour ?


que souhaites tu obtenir, au final ?


je t'ai soumis deux fonctions qui permettent :
- de savoir si une date donnée est feriée ou non
- de déterminer une date ouvrée, en partant d'une date donnée et du nombre de jours ouvrés entre les deux

exemple :

? formatdatetime(DateAdd("WD", 10, date), vbLongDate)
mardi 7 avril 2009

http://www.codyx.org/snippet_trouver-prochain-jour-ouvrable-partir-date-selon-delta_183.aspx#1843

on peut tout a fait appeler ta fonction IsFerie au lieu de ma fonction IsHoliday...


JPlusNBJour devient alors:

Public Function JPlusNbJour(ByVal Date1 As Date, ByVal Number As Long) As Date
Dim nStep As Integer
Dim nCount As Long
nStep = Sgn(Number)
If nStep Then
nCount = Abs(Number)
JPlusNbJour = Date1 + nStep
Do While nCount
If Not IsFerie(JPlusNbJour) Then
nCount = nCount - 1
End If
If nCount Then
JPlusNbJour = JPlusNbJour + nStep
End If
Loop
Else
JPlusNbJour = Date1
End If
End Function
Messages postés
38
Date d'inscription
mercredi 11 mars 2009
Statut
Membre
Dernière intervention
1 mars 2010

re
au final je veux juste remplir   date_enregistrement et quand je clic dessus , que le reste ce remplisse tout seul

merci
iblis
Messages postés
38
Date d'inscription
mercredi 11 mars 2009
Statut
Membre
Dernière intervention
1 mars 2010

re
alors date enregistrement jeudi 26/3
alors date saisie vendredi 27/3
 valeur bdf lundi 30/3
datej3 1/4

encore merci

iblis
Messages postés
38
Date d'inscription
mercredi 11 mars 2009
Statut
Membre
Dernière intervention
1 mars 2010

merci pour ton aide

ca fonctionne parfait enfin il faut encore que je parametre les jours feriés particuliers en Alsace et les ponts

iblis
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
ok ok.

j'ai formaté ta fonction, pour y voir plus clair:


Private Function IsFerie(Date_testee As Date) As Boolean
Dim JJ As Integer, AA As Integer, MM As Integer
Dim NbOr As Integer, Epacte As Integer
Dim PLune As Date, Paques As Date, Ascension As Date, Pentecote As Date

If Weekday(Date_testee, vbMonday) 6 Or Weekday(Date_testee, vbMonday) 7 Then
IsFerie = True
Else
JJ = Day(Date_testee)
MM = Month(Date_testee)
AA = Year(Date_testee)
If JJ 1 And MM 1 Then
IsFerie = True '1 Janvier
ElseIf JJ 10 And MM 4 Then
IsFerie = True ' 10 avril vendredi saint
ElseIf JJ 1 And MM 5 Then
IsFerie = True '1 Mai
ElseIf JJ 8 And MM 5 Then
IsFerie = True '8 Mai
ElseIf JJ 14 And MM 7 Then
IsFerie = True '14 Juillet
ElseIf JJ 15 And MM 8 Then
IsFerie = True '15 Août
ElseIf JJ 1 And MM 11 Then
IsFerie = True '1 Novembre
ElseIf JJ 11 And MM 11 Then
IsFerie = True '11 Novembre
ElseIf JJ 25 And MM 12 Then
IsFerie = True '25 Décembre
Else
NbOr = (AA Mod 19) + 1
Epacte = (11 * NbOr - (3 + Int((2 + Int(AA / 100)) * 3 / 7))) Mod 30
PLune = DateSerial(AA, 4, 19) - ((Epacte + 6) Mod 30)
If Epacte = 24 Then
PLune = PLune - 1
End If
If Epacte = 25 And (AA >= 1900 And AA < 2000) Then
PLune = PLune - 1
End If
Paques = PLune - Weekday(PLune) + vbMonday + 7 'Paques
If JJ Day(Paques) And MM Month(Paques) Then
IsFerie = True
Else
Ascension = Paques + 38 'Ascension
If JJ Day(Ascension) And MM Month(Ascension) Then
IsFerie = True
Else
Pentecote = Ascension + 11 'Pentecote
If JJ Day(Pentecote) And MM Month(Pentecote) Then
IsFerie = True
End If
End If
End If
End If
End If
End Function
Messages postés
38
Date d'inscription
mercredi 11 mars 2009
Statut
Membre
Dernière intervention
1 mars 2010

encore merci une petite question peut on integrer directement le vendredi saint pas rapport au lundi de paques quelque soit l'année

merci

iblis
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
le vendredi précédant le dimanche de Pâques.

paques-3

tout bêtement
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
donc, un petit :

If Date_testee = (Paques - 3) Then '# Vendredi saint
IsFerie = True
End If

a ajouter
Messages postés
38
Date d'inscription
mercredi 11 mars 2009
Statut
Membre
Dernière intervention
1 mars 2010

encore mille merci pour toute tes reponses

maintenant je vais pouvoir m'atteler a VB pour securiser tout ca

iblis
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
a supprimer :
'ElseIf JJ 10 And MM 4 Then
' IsFerie = True ' 10 avril vendredi saint

de ta fonction.

J'ai comparé avec ma fonction, ca va, jusqu'à 2049.
après, c'est pas bon

Date........................Toi....Moi
lundi 19 avril 2049.........Faux...Vrai
lundi 26 avril 2049.........Vrai...Faux
jeudi 27 mai 2049...........Faux...Vrai
jeudi 3 juin 2049...........Vrai...Faux
lundi 7 juin 2049...........Faux...Vrai
lundi 14 juin 2049..........Vrai...Faux

la faute a la date de paques:

? paques
26/04/2049

? easter(2049)
18/04/2049

j'ai vérifié, ma date est correcte
http://www.quid.fr/2007/Mesure_Du_Temps/Calendrier_Ecclesiastique/1

a noter que j'ai mis a jour ma source:
http://www.codyx.org/snippet_jours-feries-dimanche_355.aspx

j'ai indiqué comment gérer le Vendredi Saint
Messages postés
38
Date d'inscription
mercredi 11 mars 2009
Statut
Membre
Dernière intervention
1 mars 2010

bonjour

je te remercie pour tout ca
enfin si tout va bien en 2049 je serai a la retraite

j'en profite pour te poser une petite question dans un formulaire j'ai une liste deroulante pour remplir une zone je voudrai quand la premiere zone est rempli, remplir automatiquement une 2 zone sachant que dans la table qui serre a remplir la premiere zone il y a 2 colonne la premiere colonne serre a remplir la premiere zone et la 2 serre a remplir la 2 zone

merci

a +

thierry

iblis
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
69
jouant avec Access et ADODB (Microsoft ActiveX Data Object

Private moConnection As Connection

Private Sub Combo1_Click()
Dim oRs As Recordset
Set oRs = New Recordset
oRs.Open "SELECT `Champ2` FROM `Table1` WHERE `Champ1`='" & Replace(Combo1.Text, "'", "''") & "' ORDER BY 1", moConnection, adOpenForwardOnly, adLockReadOnly, adCmdText
With Combo2
.Clear
Do Until oRs.EOF
.AddItem oRs.Fields(0).Value
oRs.MoveNext
Loop
If .ListCount Then
.ListIndex = 0
End If
oRs.Close
End With
End Sub

Private Sub Form_Load()
Dim oRs As Recordset
Set moConnection = New Connection
moConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\a.mdb"

Set oRs = New Recordset
oRs.Open "SELECT DISTINCT `Champ1` FROM `Table1`", moConnection, adOpenForwardOnly, adLockReadOnly, adCmdText
With Combo1
.Clear
Do Until oRs.EOF
.AddItem oRs.Fields(0).Value
oRs.MoveNext
Loop
If .ListCount Then
.ListIndex = 0
End If
oRs.Close
End With
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
moConnection.Close
End Sub
Messages postés
38
Date d'inscription
mercredi 11 mars 2009
Statut
Membre
Dernière intervention
1 mars 2010

re

je te remercie pour ta reponse rapide je testerai cet apm si j'ai un peu de temps

tu es vraiement plus rapide que l'eclaire

encore merci

thierry

iblis
Messages postés
38
Date d'inscription
mercredi 11 mars 2009
Statut
Membre
Dernière intervention
1 mars 2010

BONJOUR

je viens a nouveau te poser une petite question voila
pour imprimer automatiquement un etat suite a une requete, j'utilise cette ceci
 Dim stDocName As String


    stDocName = "selection service avant impression pnc douanes p-div impots"
    DoCmd.OpenReport stDocName, , , 2
   
Exit_Commande4_Click:
    Exit Sub


Err_Commande4_Click:
    MsgBox Err.Description
    Resume Exit_Commande4_Click

mais je m'arrive pas a l'imprimer 2 fois comme c'est la il m'imprime une fois l'etat et une fois le formulaire je n'ai pas trouvé pourquoi as tu une petite idée la dessus

merci

thierry




iblis