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
138
139
140
141
142
143
144
145
146
147
148
| Option Compare Database
Option Explicit
Private Sub btnEncoder_Click()
Dim SemaineVal As Integer
Dim idate As Date
Dim strsql As String
'Vérifier que les valeurs saisies sont bien des dates
If IsDate(Me.txtDateDebut) And IsDate(Me.txtDatefin) Then
'Vérifier l'ordre des dates saisies
If Me.txtDateDebut < Me.txtDatefin Then
'Purger la table T_Tampon
DoCmd.SetWarnings False
DoCmd.RunSQL "DELETE T_CodeDateSuivi FROM T_Tampon;"
'Réinitialiser CodeDateSuivi
DoCmd.RunSQL "ALTER TABLE [T_Tampon] ALTER [CodeDateSuivi] COUNTER(1,1) ;"
'Boucler la valeur avec un pas de 7
For idate = Me.txtDateDebut To Me.txtDatefin Step 7
SemaineVal = Semaine(idate)
'Créer la requête SQL et ajouter dans T_Tampon
strsql = "INSERT INTO T_Tampon ( SemaineNum, DateSemaine )" _
& " VALUES (" & SemaineVal & ",#" & Format(idate, "mm/dd/yyyy") & "#)"
DoCmd.RunSQL strsql
Next idate
'Réinitialiser les colonnes (autres que CodeDateSuivi) de T_DateDeSuivi
DoCmd.RunSQL "UPDATE T_DateDeSuivi SET T_DateDeSuivi.SemaineNum = Null," _
& "T_DateDeSuivi.DateSemaine = Null, T_DateDeSuivi.CodeDateSuivi_RFP = Null," _
& "T_DateDeSuivi.CodeDateSuivi_RIM = Null;"
'Regarnir T_DateDeSuivi avec T_Tampon
'(transfert ligne par ligne, des colonnes de T_Tampon dans T_DateDeSuivi)
DoCmd.RunSQL "UPDATE T_DateDeSuivi INNER JOIN T_Tampon " _
& "ON T_DateDeSuivi.CodeDateSuivi = T_Tampon.CodeDateSuivi " _
& "SET T_DateDeSuivi.SemaineNum = [T_Tampon].[SemaineNum], " _
& "T_DateDeSuivi.DateSemaine = [T_Tampon].[DateSemaine], " _
& "T_DateDeSuivi.CodeDateSuivi_RFP = [T_Tampon].[CodeDateSuivi_RFP], " _
& "T_DateDeSuivi.CodeDateSuivi_RIM = [T_Tampon].[CodeDateSuivi_RIM];"
DoCmd.SetWarnings True
Else
MsgBox " La date de fin est antérieure à la date de début ! corrigez !"
Exit Sub
End If
Else
MsgBox "Vous n'avez pas saisi des dates !"
Exit Sub
End If
Me.T_DateDeSuivi.Requery
End Sub
'---------------------------------------------------------------------------------------
' CopyRight : Ce code est librement ditribuable, copiable et imprimable, sous la seule
' contrainte de laisser visible la totalité des commentaires identifiant
' l'auteur de ce code, ses coordonnées et ce copyright et ce, sans
' limitation de durée dans le temps.
'---------------------------------------------------------------------------------------
' Module : modDateTimeFunctions
' Date : vendredi 21 décembre 2007 13:53
' Auteur : Maxence Hubiche (mhubiche@club-internet.fr - 06.18.61.14.35)
'---------------------------------------------------------------------------------------
Public Function Semaine(LaDate As Variant) As Variant
'---------------------------------------------------------------------------------------
' Procedure : Semaine
' Date : vendredi 21 décembre 2007 13:56
' Auteur : Maxence Hubiche (mhubiche@club-internet.fr - 06.18.61.14.35)
' Objet : Renvoie le numéro de la semaine pour le calendrier français
' Spec : Cette fonctino empèche le débordement en semaine 53, en mettant les jours
' de la semaine 53 en semaine 1
' Retour : Renvoie un Byte (n° de la semaine) ou Null si l'argument n'était pas une
' date
'---------------------------------------------------------------------------------------
'
Dim bytTemp As Byte
If IsDate(LaDate) Then
bytTemp = CByte(DatePart("ww", LaDate, vbMonday, vbFirstFourDays)) Mod 53
If bytTemp = 0 Then bytTemp = 1
Semaine = bytTemp
Else
Semaine = Null
End If
End Function
Private Sub btnencoderRFP_Click()
Dim semaineRFP As Integer
Dim idate As Date
Dim strsql As String
'Vérifier que les valeurs saisies sont bien des dates
If IsDate(Me.DateRFPDebut) And IsDate(Me.DateRFPFin) Then
'Vérifier l'ordre des dates saisies
If Format(Me.DateRFPDebut, "mm/dd/yyyy") < Format(Me.DateRFPFin, "mm/dd/yyyy") Then
'Boucler la valeur avec un pas de 7
semaineRFP = 1
For idate = Me.DateRFPDebut To Me.DateRFPFin Step 7
DoCmd.SetWarnings False
'Créer la requête SQL de mise à jour
strsql = "UPDATE T_DateDeSuivi SET T_DateDeSuivi.CodeDateSuivi_RFP =" & semaineRFP _
& " WHERE T_DateDeSuivi.SemaineNum=" & Semaine(idate)
DoCmd.RunSQL strsql
semaineRFP = semaineRFP + 1
Next idate
DoCmd.SetWarnings True
Else
MsgBox " La date de fin est antérieure à la date de début ! corrigez !"
Exit Sub
End If
Else
MsgBox "Vous n'avez pas saisi des dates !"
Exit Sub
End If
Me.T_DateDeSuivi.Requery
End Sub
Private Sub btnEncoderRIM_Click()
Dim semaineRIM As Integer
Dim idate As Date
Dim strsql As String
'Vérifier que les valeurs saisies sont bien des dates
If IsDate(Me.DateRIMDebut) And IsDate(Me.DateRIMFin) Then
'Vérifier l'ordre des dates saisies
If Format(Me.DateRIMDebut, "mm/dd/yyyy") < Format(Me.DateRIMFin, "mm/dd/yyyy") Then
'Boucler la valeur avec un pas de 7
'Commencer la numérotation RIM à "1"
semaineRIM = 1
For idate = Me.DateRIMDebut To Me.DateRIMFin Step 7
DoCmd.SetWarnings False
'Créer la requête SQL de mise à jour
strsql = "UPDATE T_DateDeSuivi SET T_DateDeSuivi.CodeDateSuivi_RIM =" & semaineRIM _
& " WHERE T_DateDeSuivi.SemaineNum=" & Semaine(idate)
DoCmd.RunSQL strsql
semaineRIM = semaineRIM + 1
Next idate
DoCmd.SetWarnings True
Else
MsgBox " La date de fin est antérieure à la date de début ! corrigez !"
Exit Sub
End If
Else
MsgBox "Vous n'avez pas saisi des dates !"
Exit Sub
End If
Me.T_DateDeSuivi.Requery
End Sub |
Alimenter table à partir de date
Répondre avec citation
)
Partager