probleme de mise a jour dateRésolu

Question

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

Renfield · Accepted Answer

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 ?

Renfield · Answer

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

kefir1998 · Answer

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

Renfield · Answer

? formatdatetime(JPlusNbJour1(#03/25/2009#, 3), vbLongDate)
mardi 31 mars 2009

Pourquoi ne tombe je pas sur le Lundi ?

kefir1998 · Answer

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

Renfield · Answer

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

kefir1998 · Answer

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

kefir1998 · Answer

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

Renfield · Answer

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

kefir1998 · Answer

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

Renfield · Answer

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

kefir1998 · Answer

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

Renfield · Answer

le vendredi précédant le dimanche de Pâques. 

paques-3

tout bêtement

Renfield · Answer

donc, un petit :

If Date_testee = (Paques - 3) Then '# Vendredi saint
    IsFerie = True
End If

a ajouter

kefir1998 · Answer

encore mille merci pour toute tes reponses

maintenant je vais pouvoir m'atteler a VB pour securiser tout ca

iblis

Renfield · Answer

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

kefir1998 · Answer

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

Renfield · Answer

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

kefir1998 · Answer

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

kefir1998 · Answer

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

Renfield · Answer

pas sur d'avoir compris.

pose ta question sur un nouveau topic du forum, d'autres y viendront plus facilement.

Probleme de mise a jour date

21 réponses

Votre réponse

Discussions similaires