Discussion :

[paolo2002]

Bonjour à tous,

J'ai écrit une fonction qui me calcul la date du vendredi connaissant le numéro de semaine et l'année:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
 
 
Function jour_semaine_Dimanche(Semaine, annee)
	Dim JourDeLAn
	Dim MonJourSem
	Dim NbresJours
	Dim An
	Dim Sem
 
	An = Cint(annee)
	Sem = Cint(Semaine)
 
	' Recherche le jour de l'an de l'annee
	JourDeLAn = CDate("01/01/" & An)
	' Recherche le jour de l'an tombe quel jour (Lundi, mardi, .......)
	MonJourSem = WeekDay(JourDeLAn, 2)
 
	jour_semaine_Dimanche = Cstr(((CDate("01/01/" & An)) - MonJourSem) + (((Sem) - 1) * 7) + 5)
 
End Function
 
 
Function GetVendredi(wn, y)
	GetVendredi = DateAdd("ww", wn, CDate("01/01/" & y)) - Weekday(CDate("01/01/" & y)) + 6
End Function
 
Function SelectFunc(wn, y)
 
	If WeekDay(CDate("01/01/" & y)) > 5 then
		SelectFunc = GetVendredi(wn,y)
	Else
		SelectFunc = jour_semaine_Dimanche(wn,y)
    End If
End Function
 
Message = SelectFunc(45,2012)
MsgBox "date " & Message

Malheureusement cela ne fonctionne pas pour l'année 2012 et je ne comprends pas trop pourquoi .

Si quelqu'un pouvait m'aider ......

Merci d'avance

[SfJ5Rpw8]

Bonsoir,

je crois qu'il faut que tu revois ton calcul de semaine.. en 2012 la semaine 1 commence le 2/1/2012

[paolo2002]

Merci pour ta réponse,

Mais je n'ai pas trop compris, ta remarque sur le calcul de la semaine.

[l_autodidacte]

Pourtant, ce code fonctionne correctement sur ma machine. J'ai vérifié avec Propriétés de Date et Heure(depuis la barre des tâches)

[paolo2002]

Pour répondre à l_autodidacte,

Exemple:
semaine = 47
Année = 2012

Réponse = 16/11/2012 au lieu de 23/11/2012.

Sur l'exemple de mon premier post: semaine = 45, année = 2012, la réponse devrait être le 09/11/2012 et non le 02/11/2011.

Lorsque je fais mon test mon l'année 2011 par exemple, je n'ai pas de preoblème.

[l_autodidacte]

Désolé car je n'ai bien saisi le problème qui se résume en fait(et à mon humble avis) à voir si l'année est bissextile ou pas et agir en conséquence. En voici une esquisse :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Function JourDeLan(An)
    Dim JDL : An = CInt(An)
	If Bissextile(An) = True Then
	   JDL = "02/01/" & Cstr(An)
	Else  
	   JDL = "01/01/" & Cstr(An)
	End If
	JourDeLAn = JDL
End Function
'=======================
Function jour_semaine_Dimanche(Semaine, annee)
	'Dim JourDeLAn
	Dim MonJourSem
	Dim NbresJours
	Dim An
	Dim Sem
	An = Cint(annee)
	Sem = Cint(Semaine)
	' Recherche le jour de l'an tombe quel jour (Lundi, mardi, .......)
	MonJourSem = WeekDay(JourDeLAn(An), 2)
 	jour_semaine_Dimanche = Cstr((CDate(JourDeLAn(An)) - MonJourSem) + (((Sem) - 1) * 7) + 5)
End Function
'=====================
Function Bissextile(An)
    Bissextile = ((An mod 400)=0) or (((An mod 4)=0) and ((An mod 100)<>0))
End Function
'======================
Function GetVendredi(wn, y)
	GetVendredi = DateAdd("ww", wn, CDate(JourDeLAn(y))) - Weekday(CDate(JourDeLAn(y))) + 6
End Function
'======================
Function SelectFunc(wn, y)
	If WeekDay(CDate(JourDeLAn(y))) > 5 then
		SelectFunc = GetVendredi(wn,y)
	Else
		SelectFunc = jour_semaine_Dimanche(wn,y)
    End If
End Function
'=======================
Message = SelectFunc(47,2012)
MsgBox "date : " & WeekDayName(WeekDay(Message)) & " " & Message

Les dates recherchées s'affichent correctement avec ce code.

[paolo2002]

Merci beaucoup pour vos réponses .

[ProgElecT]

Salut

Une autre possibilité, à partir de Comment déterminer la date du premier jour d'une semaine ? (FAQ Access DVP)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Function PremierJourSemaine(numSemaine, annee)
 
    Dim d ' As Date
    Dim numS ' As Integer
 
    ' premier jour de l'année
    d = DateSerial(annee, 1, 1)
 
    ' numéro de la semaine du 1er janvier
    numS = DatePart("ww", d, 2, 2)
 
    ' si le 1er janvier fait partie de la dernière semaine de l'année précédente
    ' alors passe à la semaine suivante (la première de la nouvelle année)
    If numS <> 1 Then d = DateAdd("d", 7, d)
 
    ' calcule le premier jour de la première semaine de l'année
    d = DateAdd("d", 1 - Weekday(d, 2), d)
 
    ' ajoute (numSemaine-1) semaines
    PremierJourSemaine = DateAdd("ww", numSemaine - 1, d)
 
End Function
Function DateNomJSem(PremJSem, NumDuJ)
'VbSunday 1 Dimanche (valeur par défaut)
'vbMonday 2 Lundi
'vbTuesday 3 Mardi
'vbWednesday 4 Mercredi
'vbThursday 5 Jeudi
'vbFriday 6 Vendredi
'vbSaturday 7 Samedi
Dim T
DateNomJSem = PremJSem
For T = 0 To 6
    If Weekday(DateAdd("d", T, PremJSem)) = NumDuJ Then
        DateNomJSem = DateAdd("d", T, PremJSem)
        Exit For
    End If
Next
End Function
 
MsgBox "date du vendredi de la semaine 45 de 2011" & vbCrLf & DateNomJSem((PremierJourSemaine(45, 2011)), 6)