Discussion :

[gpanpan]

Bonjour,

je cherche comment déterminer déterminer la date du Xème Dimanche du mois.

Exemple: le 3ème Dimanche du mois d'octobre 2008 est le 19/10/2008

Si vous avez une solution simple en vbs ?

Merci d'avance.

[pc75]

Bonjour,

Juste une idée (pas testé). Tu fais une boucle et teste la valeur du jour

Code :

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

1
2
3
4
5
6
7
8
 
LeJour = "01/10/2008"
do while le jour <= "31/10/2008"
  if weekday(LeJour) = 7 then
     msgbox "c'est un dimanche"
  end if
  LeJour = dateadd("d", 1, LeJour)
loop

[gpanpan]

Oui ca fonctionne pour trouver si on est bien le dimanche j'ai corrigé dans ton code le

Code :

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

1
2
 
if weekday(LeJour) = 7 then ' Si on est Samedi

Par

Code :

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

1
2
 
if weekday(LeJour) = 1 then ' Si on est Dimanche

je n'avais pas pensé à ça merci pour le code.

Mon second problème est de déterminer pour chaque mois quel est la date du 3ème Dimanche du mois et que le 3ème.

Si tu as une idée, car là je suis sur un casse tête, je vais voir avec des plages de date genre tester entre si je suis entre le 15 et le 21 du mois et que le weekday est dimanche alors je serrais le 3ème dimanche du mois !

Si tu as plus simple ?

Merci

[pc75]

Re,

Tu utilises un compteur :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
LeJour = "01/10/2008"
Cpt = 1
do while le jour <= "31/10/2008"
  if weekday(LeJour) = 1 then
     Cpt = Cpt + 1
  end if
  if Cpt = 3 then
     msgbox "c'est le 3ème dimanche"
  end if
  LeJour = dateadd("d", 1, LeJour)
loop

[gpanpan]

Re

ça fait trop longtemps que je suis devant l'écran je crois !

C'est tout bête mais là je crois que je suis plus en état de réfléchir lol.

en tout cas merci pour l'aide, c'est top

En fait le problème du compteur va poser un problème pour le mois de Février sauf si on le gère spécifquement.

[pc75]

En fait le problème du compteur va poser un problème pour le mois de Février sauf si on le gère spécifquement.

A priori, il faudra effectivement gérer les exceptions.

[droggo]

Joa,

* Bien entendu, gérer les dépassements
- pour février, pas plus de 4 dimanches possibles, sauf années bissextiles, où il peut y en avoir 5
- pour les autres mois, pas plus de 5

* Puis, une fois que c'est géré :
- Regarder à quel jour correspond le 1er du mois désiré
- Ça nous donne tout de suite la date du 1er dimanche de ce mois (petit calcul simple)
- ajouter (X-1)*7 pour avoir la date du Xième dimanche du mois

[gpanpan]

Voici la solution :

je n'ai pas eu le temps de la posté plustôt mais voici pour ceux que ça interesse :

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
 
' ##################################################
' #														
' #		Recherche du n ème jour du mois en cours				
' #		ici on recherche le 3 ème Vendredi du mois en cours				
' #														
' #		Créé le  : 17/10/2008                  			       				
' #		Dernière modification : 18/10/2008                            				
' #		Par : gpanpan								
' #		Version : 1.0	
' # 		Language : VBS									
' #														
' ##################################################
 
 
'    DÉCLARATION DES VARIABLES
Dim JourRechercher, nDay, DateActu, MoisActu, AnneeActu, RechercherJour, Cpt
 
JourRechercher = "Dimanche"		' Jour Rechercher
nDay = 3						' n ème Jour Rechecherché
 
DateActu = Date					'Recup de la date du jour
 
Cpt = 0							' Compteur
 
 
'   AFFECTATION DES VARIABLES
' ---  Mois actuel en chiffre ---
' vbSunday définit le Dimanche comme étant le premier jour de la semaine comme sous Unix
MoisActu = (DatePart("m", DateActu,vbSunday))
 
' --- Annee actuel ---
' vbSunday définit le Dimanche comme étant le premier jour de la semaine comme sous Unix
AnneeActu = (DatePart("yyyy", DateActu,vbSunday))
' -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'=============================================================================
' Fonction qui retourne le nombre de jour du mois prend en compte les années bissextiles 
'=============================================================================
Function DaysInMonth(Mois, Annee)
    DaysInMonth = Day(DateAdd("d", -1, DateAdd("m", 1, DateSerial(Annee, Mois, 1)))) 
End Function 
 
' -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'======================================================
' Fonction qui retourne le X ème  jour définit du mois en cours  
'======================================================
Function XemeDayOfMonth (JourRechercher, FirtDayMonth, LastDayMonth, MoisActu)
 
	' Si nDay est supérieur à 1 alors on est pas le nème jour du mois sinon on est le premier 
	' Ceci est juste pour l'affichage de message.
	Select Case (nDay)
		Case 0:
			msgbox "ERREUR sur le n ème jour recherché !" & vbcrlf _
			& " Il n'y a pas 0 jour dans un mois", vbcritical, "ERREUR sur le n ème jour recherché"
			Exit Function
		Case Else:
			If nDay > 1 Then
				Xeme = "ème "
			Else
				Xeme = "er "
			End If
	End Select
 
	' En fonction du jour Recherché on affecte à la variable la constante vb qui correspond
	Select Case (JourRechercher)
		case "Dimanche":
			RechercherJour = vbSunday
		case "dimanche":
			RechercherJour = vbSunday 
		Case "Lundi":
			RechercherJour = vbMonday  
		Case "lundi":
			RechercherJour = vbMonday 
		Case "Mardi":
			RechercherJour = vbTuesday 
		Case "mardi":
			RechercherJour = vbTuesday 
		Case "Mercredi":
			RechercherJour = vbWednesday
		Case "mercredi":
			RechercherJour = vbWednesday
		Case "Jeudi":
			RechercherJour = vbThursday 
		Case "jeudi":
			RechercherJour = vbThursday
		Case "Vendredi":
			RechercherJour = vbFriday 
		Case "vendredi":
			RechercherJour = vbFriday 
		Case "Samedi":
			RechercherJour = vbSaturday 
		Case "samedi":
			RechercherJour = vbSaturday
	End Select
 
	' On boucle tant que l'on a pas atteint le dernier jour du mois
	do while FirtDayMonth <= LastDayMonth	
		if weekday(FirtDayMonth) = RechercherJour  then		' Si le jour correspond au jour recherché alors
			Cpt = Cpt+1										' On incremente le compteur
		end if
		if Cpt = nDay then									' Si le compteur correspond au n ème jour recherché alors
			SearchDay = FirtDayMonth						' On affect le jour à la varible pour l'affichage
			' Test du mois
			MoisSearchDay = (DatePart("m", SearchDay,vbSunday))
			if MoisSearchDay > MoisActu then
				msgbox "ERREUR sur le n ème jour recherché !" & vbcrlf _
				& " Il n'y a pas " & nDay & " " & JourRechercher _
				& " dans ce mois ci", vbcritical, "ERREUR sur le n ème jour recherché"
				Exit Function
			end if
			Exit Do											'  On sort de la fonction
		else												' Sinon 
			FirtDayMonth = dateadd("d", 1, FirtDayMonth)	' On incremente le jour de 1
		end if
	loop
	msgbox SearchDay & " est le " & nDay & Xeme & JourRechercher & " du mois"
 
End Function
 
' -------------------------------------------------------------------------------------------------------------------------------------------------------------------------------
 
' *********************************************
'  ENCHAINEMENT DES INSTRUCTIONS
' *********************************************
 
' Appel de la fonction DaysInMonth
NbJoursDuMois = DaysInMonth (MoisActu, AnneeActu)
 
' Affectation des variables
LastDayMonth = NbJoursDuMois & "/" & MoisActu & "/" & AnneeActu
FirtDayMonth  = "01/" & MoisActu & "/" & AnneeActu
 
' Appel de la fonction XemeDayOfMonth
XemeDayOfMonth JourRechercher, FirtDayMonth, LastDayMonth, MoisActu
 
msgbox "fin"
Wscript.quit

Voilà c'est peut être pas parfait mais ça fonctionne bien.