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 |
