Aux pros des do until avec des dates à extraires de la condition

Le
warman57
Bonsoir à tous et toutespremier post et j'y vais à fondvoici mon
problème:
j'ai une petite appli de gestion de cantine avec un form qui
represente graphiquement les jours du mois; on clique simplement sur
un jour pour signaler la présence d'un enfant et bien sûr cela
alimente une table de présence
Le problème c'est que la personne qui saisie doit se taper un clic sur
chaque jour de présence et ce par enfant
J'ai donc l'intention d'ajouter un bouton qui coloriera tous les
jours! Cela j'y arrive avec le code ci-après
Le problème me direz-vous.J'aimerai extraire de ces dates les
mercredis, samedis et dimanches et là je tourne, je retourne.

Dans mon form un champs scrCDate qui donne le premier jour du mois
un champs nbre de jour qui retourne le nombre de jour du mois

le code sur le fameux bouton:
Actuellement en l'état il marche bien mais il colorie tous les jours:
Merci de votre aide

Dim TDate As Date, C1 As Integer, StrSQL As String, TypeAttend,
RecDetect
C1 = 0: TDate = Me![scrCDate] - 1
Do Until C1 = Me![nbrejour]
TDate = DateAdd("d", 1, TDate)
C1 = C1 + 1

TypeAttend = DLookup("Cantine", "Attend", "[AttStudent] = " & Me!
[scrStudent] & " AND [AttDate] = #" & Format(TDate, "mm/dd/yy") & "#")
If IsNull(TypeAttend) Then
TypeAttend = 0
End If
TypeAttend = TypeAttend + 1
If TypeAttend > 1 Then
TypeAttend = 0
End If

RecDetect = DLookup("[scrStudent]", "Attend", "[AttStudent] = " & Me!
[scrStudent] & " AND [AttDate] = #" & Format(TDate, "mm/dd/yy") & "#")
'Ecrit ds la table Attend
'Si date donc ligne n'existe pas
If IsNull(RecDetect) Then
StrSQL = "INSERT INTO Attend ( AttStudent, AttDate, Cantine,
tarif_cantine ) " _
& "SELECT " & Me![scrStudent] & " AS F1, #" _
& Format(TDate, "mm/dd/yy") & "# AS F2, " & TypeAttend & " AS
F3,'" & BBB & "' AS F4;"
DoCmd.RunSQL StrSQL
Else
'Si date donc ligne existe
StrSQL = "UPDATE Attend SET Attend.cantine = " & TypeAttend _
& " WHERE (((Attend.AttStudent)=" & Me![scrStudent] & ") AND" _
& "((Attend.AttDate)=#" & Format(TDate, "mm/dd/yy") & "#));"
DoCmd.RunSQL StrSQL
If TypeAttend = 0 Then
StrSQL = "UPDATE Attend SET Attend.tarif_cantine ='" & renew & "'"
_
& " WHERE (((Attend.AttStudent)=" & Me![scrStudent] & ") AND" _
& "((Attend.AttDate)=#" & Format(TDate, "mm/dd/yy") & "#));"
DoCmd.RunSQL StrSQL
Else
StrSQL = "UPDATE Attend SET Attend.tarif_cantine ='" & BBB & "'" _
& " WHERE (((Attend.AttStudent)=" & Me![scrStudent] & ") AND" _
& "((Attend.AttDate)=#" & Format(TDate, "mm/dd/yy") & "#));"
DoCmd.RunSQL StrSQL
End If
End If
Loop
Questions / Réponses high-tech
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Raymond [mvp]
Le #6280671
Bonjour.

directement dans ta boucle do tu connais la date du jour par TDate. tu peux
donc savoir si ce jour est un jour ouvrable ou non.
tu trouveras des fonctions de calcul de jours ouvrés et travaillés sur la
page: http://officesystem.access.free.fr/vba/jours_travailles.htm#jour_ouvre
.
tu fais appel à cette fonction immédiatement après ton
TDate = DateAdd("d", 1, TDate)
if JourOuvré(TDate ) then
' ici on travaille
end if

il faut tout de même faire une modif dans la fonction pour indiquer que le
mercredi n'est pas travaillé en modifiant la ligne : Case vbMonday To
vbSaturday

ensuite rajouter la fonction FêtesCarillonnées pour calculer les jours
fériés catholiques :
http://officesystem.access.free.fr/vba/jours_travailles.htm#fetes_carillonnees_catholiques

et enfin créer une table annuelle, éventuellement, s'il existe des jours
fériés locaux spécifiques.
--
@+
Raymond Access MVP http://OfficeSystem.Access.free.fr/
Pour débuter sur le forum: http://www.mpfa.info/
Non Stop Mix '07 - Paris. La nouvelle scène web fête la créativité !
http://www.comscamp.com/Tracker/Redirect.ashx?linkid°64304e-439a-45c7-9d2f-c3326db58273



Bonsoir à tous et toutes...premier post et j'y vais à fond...voici mon
problème:
j'ai une petite appli de gestion de cantine avec un form qui
represente graphiquement les jours du mois; on clique simplement sur
un jour pour signaler la présence d'un enfant et bien sûr cela
alimente une table de présence...
Le problème c'est que la personne qui saisie doit se taper un clic sur
chaque jour de présence et ce par enfant...
J'ai donc l'intention d'ajouter un bouton qui coloriera tous les
jours! Cela j'y arrive avec le code ci-après...
Le problème me direz-vous....J'aimerai extraire de ces dates les
mercredis, samedis et dimanches et là je tourne, je retourne....

Dans mon form un champs scrCDate qui donne le premier jour du mois
un champs nbre de jour qui retourne le nombre de jour du mois

le code sur le fameux bouton:
Actuellement en l'état il marche bien mais il colorie tous les jours:
Merci de votre aide

Dim TDate As Date, C1 As Integer, StrSQL As String, TypeAttend,
RecDetect
C1 = 0: TDate = Me![scrCDate] - 1
Do Until C1 = Me![nbrejour]
TDate = DateAdd("d", 1, TDate)
C1 = C1 + 1

TypeAttend = DLookup("Cantine", "Attend", "[AttStudent] = " & Me!
[scrStudent] & " AND [AttDate] = #" & Format(TDate, "mm/dd/yy") & "#")
If IsNull(TypeAttend) Then
TypeAttend = 0
End If
TypeAttend = TypeAttend + 1
If TypeAttend > 1 Then
TypeAttend = 0
End If

RecDetect = DLookup("[scrStudent]", "Attend", "[AttStudent] = " & Me!
[scrStudent] & " AND [AttDate] = #" & Format(TDate, "mm/dd/yy") & "#")
'Ecrit ds la table Attend
'Si date donc ligne n'existe pas
If IsNull(RecDetect) Then
StrSQL = "INSERT INTO Attend ( AttStudent, AttDate, Cantine,
tarif_cantine ) " _
& "SELECT " & Me![scrStudent] & " AS F1, #" _
& Format(TDate, "mm/dd/yy") & "# AS F2, " & TypeAttend & " AS
F3,'" & BBB & "' AS F4;"
DoCmd.RunSQL StrSQL
Else
'Si date donc ligne existe
StrSQL = "UPDATE Attend SET Attend.cantine = " & TypeAttend _
& " WHERE (((Attend.AttStudent)=" & Me![scrStudent] & ") AND" _
& "((Attend.AttDate)=#" & Format(TDate, "mm/dd/yy") & "#));"
DoCmd.RunSQL StrSQL
If TypeAttend = 0 Then
StrSQL = "UPDATE Attend SET Attend.tarif_cantine ='" & renew & "'"
_
& " WHERE (((Attend.AttStudent)=" & Me![scrStudent] & ") AND" _
& "((Attend.AttDate)=#" & Format(TDate, "mm/dd/yy") & "#));"
DoCmd.RunSQL StrSQL
Else
StrSQL = "UPDATE Attend SET Attend.tarif_cantine ='" & BBB & "'" _
& " WHERE (((Attend.AttStudent)=" & Me![scrStudent] & ") AND" _
& "((Attend.AttDate)=#" & Format(TDate, "mm/dd/yy") & "#));"
DoCmd.RunSQL StrSQL
End If
End If
Loop
warman57
Le #6280611
Merci Raymond pour ta réponse plus que rapide....

Le problème est que je veux retirer les mercredis, samedis et
dimanches

j'ai donc voulu faire un test simple, commencer par les mercredis à
exclure seulement

j'ai donc imbriqué cette commande dans le do:


Dim TDate As Date, C1 As Integer, StrSQL As String, TypeAttend,
RecDetect
C1 = 0: TDate = Me![scrCDate] - 1
Do Until C1 = Me![nbrejour] - 1

If Weekday(TDate, 3) = 1 Then
TDate = DateAdd("d", 2, TDate)
Else
TDate = DateAdd("d", 1, TDate)
End If

C1 = C1 + 1

Je veux commencer simple, alors je me suis dis, allez on commence
seulement avec les mercredis, alors si tu en trouves un, tu passes au
jour d'après....TDate = DateAdd("d", 2, TDate)
Je vais me faire "chambrer", j'ai du louper quelque chose
Cela marche bien, il retire les mercredis mais il ne s'arrête pas à la
fin du mois ici de Mai: il me selectionne également les 4 premiers
jours de juin, comme si il n'arrêtait pas à temps sa boucle!!!

J'ai l'impression d'être naze
Pour info, mon champs qui calcule le nombre de jour (nbrjour) est
calculé ainsi:
nbrjour=Jour(SérieDate(Année([scrcdate]);Mois([scrcdate])+1;1)-1)

SOS raymond en tout ca merci
warman57
Le #6280601
J'ai remarqué qu'il coloriait jusqu'à ....nbrjour

exemple: si nbrejour1 et que nous sommes au mois de mai, il cherche
absolument à colorier 31jours
par le code je lui retire 5 mercredis, donc il ne reste que 26 jours
mais lui il cherche à me remettre mes 5 mercredis donc 26+51
en réalité comme dans mon code départ je luio ai mentionné C1 = 0:
TDate = Me![scrCDate] - 1 il ne rajoute que 4 jours soit 30, voila
pourquoi il colorie les 4 jours de juin....
J'ai vérifié sur les autres mois, cela se confirme, il rajoute en
jours les mercredis retirés
J'ai trouvé l'explication mais pas la raison
GRRRRRRRRR
Raymond [mvp]
Le #6280591
il ne faut pas calculer ton nombre de jours et ensuite retirer les
mercredis, ce qui prolonge d'autant de mercredis trouvés.
il suffit de comparer ta date TDate avec la date du dernier jour du mois et
si c'est le cas tu sors de la boucle.
pour trouver le dernier jour du mois:
DateSerial(Year(Date), Month(Date) + 1, 0)

--
@+
Raymond Access MVP http://OfficeSystem.Access.free.fr/
Pour débuter sur le forum: http://www.mpfa.info/
Non Stop Mix '07 - Paris. La nouvelle scène web fête la créativité !
http://www.comscamp.com/Tracker/Redirect.ashx?linkid°64304e-439a-45c7-9d2f-c3326db58273



Merci Raymond pour ta réponse plus que rapide....

Le problème est que je veux retirer les mercredis, samedis et
dimanches

j'ai donc voulu faire un test simple, commencer par les mercredis à
exclure seulement

j'ai donc imbriqué cette commande dans le do:


Dim TDate As Date, C1 As Integer, StrSQL As String, TypeAttend,
RecDetect
C1 = 0: TDate = Me![scrCDate] - 1
Do Until C1 = Me![nbrejour] - 1

If Weekday(TDate, 3) = 1 Then
TDate = DateAdd("d", 2, TDate)
Else
TDate = DateAdd("d", 1, TDate)
End If

C1 = C1 + 1

Je veux commencer simple, alors je me suis dis, allez on commence
seulement avec les mercredis, alors si tu en trouves un, tu passes au
jour d'après....TDate = DateAdd("d", 2, TDate)
Je vais me faire "chambrer", j'ai du louper quelque chose
Cela marche bien, il retire les mercredis mais il ne s'arrête pas à la
fin du mois ici de Mai: il me selectionne également les 4 premiers
jours de juin, comme si il n'arrêtait pas à temps sa boucle!!!

J'ai l'impression d'être naze
Pour info, mon champs qui calcule le nombre de jour (nbrjour) est
calculé ainsi:
nbrjour=Jour(SérieDate(Année([scrcdate]);Mois([scrcdate])+1;1)-1)

SOS raymond en tout ca merci
warman57
Le #6280561
Ne craque pas Raymond SVP...je suis pas loin mais cela foire encore
Dans mon formulaire mon champs
scrCDate1=SérieDate(Année([scrCDate]);Mois([scrCDate])+1;0)
scrCDate renvoye le premier jour du mois

J'ai fait cela:

Dim TDate As Date, C1 As Date, StrSQL As String, TypeAttend, RecDetect
TDate = Me![scrCDate] - 1
C1 = TDate
Do Until C1 = Me![scrCdate1]
TDate = DateAdd("d", 1, TDate)
If JourTravaillé(TDate) Then
je déclenche mon sql etc....
End If
Loop
Oui j'ai repris ton code jourTravaillé sur ton site (merci!)
Et bien cela retire bien les samedis et dimanches mais encore une fois
si cela retire 8 samedis et dimanches, il les rajoute à la date de
fin, donc rebelote, je repars en JUIN
J'dois être limité, fatigué...je ne dois pas être loin mais suis pe rdu
En tout cas Raymond merci de ta patience et du fait que tu mettes des
connaissances dans le domaine public......
warman57
Le #6280541
C'est plus compliqué que cela apparement

J'ai mis un msgbox après loop pour voir la valeur de tdate
elle est au 12/06/2007
interessant quand on sait que la date de fin normalement doit être le
31 mai...
voila pourquoi il continue en juin....
Raymond [mvp]
Le #6280531
il faut mettre le test dans la loop:

Do Until TDate > DateSerial(Year(Date), Month(Date) + 1, 0)

la date:
j'ai testé:
=SérieDate(Année(Date());Mois(Date())+1;0)

chez mois ça marche, j'ai bien le 31 mai.

scrCDate1=SérieDate(Année([scrCDate]);Mois([scrCDate])+1;0)
scrCDate renvoye le premier jour du mois
est-ce une faue de frappe sinon il faut tester scrCDate1

--
@+
Raymond Access MVP http://OfficeSystem.Access.free.fr/
Pour débuter sur le forum: http://www.mpfa.info/
Non Stop Mix '07 - Paris. La nouvelle scène web fête la créativité !
http://www.comscamp.com/Tracker/Redirect.ashx?linkid°64304e-439a-45c7-9d2f-c3326db58273



C'est plus compliqué que cela apparement

J'ai mis un msgbox après loop pour voir la valeur de tdate
elle est au 12/06/2007
interessant quand on sait que la date de fin normalement doit être le
31 mai...
voila pourquoi il continue en juin....
warman57
Le #6280511
Regarde un test...

Dim TDate As Date, TDate1 As Date, C1 As Date, StrSQL As String,
TypeAttend, RecDetect
TDate = Me![scrCDate] - 1
C1 = TDate
Do Until C1 > DateSerial(year([scrCDate]), month([scrCDate]) + 1, 0)
TDate = DateAdd("d", 1, TDate)
If JourTravaillé(TDate) Then
C1 = C1 + 1
MsgBox TDate
End If
Loop

la msgbox va jusqu'au 13/06/2007 alors que normalement 31 mai

par contre, si je shoote ta fonction jourtravaillé:

Dim TDate As Date, TDate1 As Date, C1 As Date, StrSQL As String,
TypeAttend, RecDetect
TDate = Me![scrCDate] - 1
C1 = TDate
Do Until C1 = DateSerial(year(Me![scrCDate]), month(Me![scrCDate]) +
1, 0)
TDate = DateAdd("d", 1, TDate)
'If JourTravaillé(TDate) Then
C1 = C1 + 1
MsgBox TDate
'End If
Loop

Impéccable, cela s'arrête au 31 mai...KEZAKO????
Raymond [mvp]
Le #6280491
Do Until C1 > DateSerial(year([scrCDate]), month([scrCDate]) + 1, 0)
TDate = DateAdd("d", 1, TDate)
If JourTravaillé(TDate) Then
C1 = C1 + 1
MsgBox TDate
End If
Loop

le C1 n'est mouvementé que dans le IF, alors que la boucle doit tester à
chaque tour. tu ne peux pas mettre une date en test dans la boucle si
celle-ci change aléatoirement.
le C1 = C1 + 1 doit être exécuté à chaque tour.
faut-il tester le C1 ou un autre champ je ne sais pas, à toi de trouver une
date qui s'incrémente jour par jour à chaque tour du Do.

--
@+
Raymond Access MVP http://OfficeSystem.Access.free.fr/
Pour débuter sur le forum: http://www.mpfa.info/
Non Stop Mix '07 - Paris. La nouvelle scène web fête la créativité !
http://www.comscamp.com/Tracker/Redirect.ashx?linkid°64304e-439a-45c7-9d2f-c3326db58273



Regarde un test...

Dim TDate As Date, TDate1 As Date, C1 As Date, StrSQL As String,
TypeAttend, RecDetect
TDate = Me![scrCDate] - 1
C1 = TDate
Do Until C1 > DateSerial(year([scrCDate]), month([scrCDate]) + 1, 0)
TDate = DateAdd("d", 1, TDate)
If JourTravaillé(TDate) Then
C1 = C1 + 1
MsgBox TDate
End If
Loop

la msgbox va jusqu'au 13/06/2007 alors que normalement 31 mai

par contre, si je shoote ta fonction jourtravaillé:

Dim TDate As Date, TDate1 As Date, C1 As Date, StrSQL As String,
TypeAttend, RecDetect
TDate = Me![scrCDate] - 1
C1 = TDate
Do Until C1 = DateSerial(year(Me![scrCDate]), month(Me![scrCDate]) +
1, 0)
TDate = DateAdd("d", 1, TDate)
'If JourTravaillé(TDate) Then
C1 = C1 + 1
MsgBox TDate
'End If
Loop

Impéccable, cela s'arrête au 31 mai...KEZAKO????
warman57
Le #6280471
Raymond tu es un maître!!!!!!!
Effectivement j'ai ressorti le C1 de la condition SI

Voila pour ceux que ça interesse mon code (Tu vois raymond, j'ai testé
les mercredis, samedis et dimanches par Weekday, j'espère que ce n'est
pas trop lourd?!)
En tout cas merci d'avoir veillé pour moi et merci de cette belle
mentalité qui t'anime
Bon week-end!

Dim TDate As Date, TDate1 As Date, C1 As Date, StrSQL As String,
TypeAttend, RecDetect
TDate = Me![scrCDate] - 1

C1 = TDate
Do Until C1 = DateSerial(year(Me![scrCDate]), month(Me![scrCDate]) +
1, 0)
TDate = DateAdd("d", 1, TDate)
'DateCourante = CDate(dblDateDeb)
C1 = C1 + 1
If Weekday(TDate) <> 1 And _
Weekday(TDate) <> 4 And _
Weekday(TDate) <> 7 Then

'Mon p'tit sql..........

End If
Loop
Publicité
Poster une réponse
Anonyme