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
| Option Explicit
Public Function GetWeek(ByRef quand As Range) As String
Dim NumWeek As String
Dim NumYear As Integer
'Numéro de semaine de la date passée en paramètre
' semaine 1 = première semaine comportant 4 jours du mois de janvier
NumWeek = Format(DatePart("ww", quand.Value, vbMonday, vbFirstFourDays), "00")
'Soustrait 4 jours à la date passée en paramètre si la semaine n'est pas la première semaine de l'année
' permet de bien prendre le numéro de l'année précédente si la semaine appartient à l'année précédente
If Val(NumWeek) > 1 Then quand = quand - 4
'Numéro de l'année
NumYear = DatePart("yyyy", quand, vbMonday, vbFirstFourDays)
'Formate le numéro d'année en fonction de sa valeur
If Val(NumYear) < 2010 And Val(NumYear) >= 2000 Then
NumYear = Format(Val(Right(NumYear, 1)), "0")
Else
NumYear = Format(Val(Right(NumYear, 2)), "00")
End If
GetWeek = NumYear & NumWeek
End Function
Public Function GetDate(quand As String) As Date
Dim Week As Integer
Dim Year As Integer
Dim Result As Date
Week = Val(Right(quand, 2))
Year = Val(Left(quand, Len(quand) - 2))
'Ajoute les miliers pour trouver la bonne année
If Year <= 90 Then
Year = Year + 2000 '-----------------------------'
Else '!!!!! BUG PREVU EN 2090 !!!!!'
Year = Year + 1900 '-----------------------------'
End If
'Le premier janvier de l'année "Year"
Result = CDate("01/01/" & Year)
'Se rend au premier jour de la semaine 1 de l'année "Year"
While DatePart("ww", Result, vbMonday, vbFirstFourDays) > 1
Result = DateAdd("d", 1, Result)
Wend
While Weekday(Result, vbMonday) >= vbMonday
Result = DateAdd("d", -1, Result)
Wend
'Ajoute le nombre de semaine "Week"
Result = DateAdd("ww", Week - 1, Result)
GetDate = Result
End Function
Public Function WeekDifference(Date1 As String, Date2 As String) As Integer
Dim D1 As Date
Dim D2 As Date
D1 = CDate(GetDate(Date1))
D2 = CDate(GetDate(Date2))
WeekDifference = Int((D2 - D1) / 7)
End Function
Public Function DateDiffrence(Date1 As String, Date2 As String) As Integer
Dim D1 As Date
Dim D2 As Date
D1 = CDate(Date1)
D2 = CDate(Date2)
'Se rend au premier jour de la semaine des deux dates
While Weekday(D1, vbMonday) >= vbMonday
D1 = DateAdd("d", -1, D1)
Wend
While Weekday(D2, vbMonday) >= vbMonday
D2 = DateAdd("d", -1, D2)
Wend
DateDiffrence = Int((D2 - D1) / 7)
End Function
Public Function WeekAdd(Ref As Integer, Number As Integer) As Integer
Dim Year As Integer
Dim Year2 As Integer
Dim Week As Integer
Week = Val(Right(Ref, 2))
Year = Val(Left(Ref, Len(Str(Ref)) - 3))
Year2 = Year
'Ajoute les miliers pour trouver la bonne année
If Year2 <= 90 Then
Year2 = Year2 + 2000 '-----------------------------'
Else '!!!!! BUG PREVU EN 2090 !!!!!'
Year2 = Year2 + 1900 '-----------------------------'
End If
If Week + Number > DatePart("ww", CDate("31/12/" & Year2), vbMonday, vbFirstFourDays) Then
Week = 1
Year = Year + 1
ElseIf Week + Number <= 0 Then
Week = DatePart("ww", CDate("31/12/" & Year2 - 1), vbMonday, vbFirstFourDays)
Year = Year - 1
Else
Week = Week + Number
End If
Year = Year * 100
WeekAdd = Year + Format(Week, "00")
End Function |
