kefir1998
Messages postés38Date d'inscriptionmercredi 11 mars 2009StatutMembreDernière intervention 1 mars 2010
-
24 mars 2009 à 13:11
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 2021
-
27 mars 2009 à 09:03
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
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 24 mars 2009 à 16:00
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
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 24 mars 2009 à 15:32
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
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
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 24 mars 2009 à 16:12
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
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 24 mars 2009 à 16:52
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
kefir1998
Messages postés38Date d'inscriptionmercredi 11 mars 2009StatutMembreDernière intervention 1 mars 2010 25 mars 2009 à 08:21
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
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 25 mars 2009 à 08:41
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
Messages postés38Date d'inscriptionmercredi 11 mars 2009StatutMembreDernière intervention 1 mars 2010 27 mars 2009 à 08:55
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
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