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
| Private Sub btnEncoder_Click()
Dim SemaineVal As String
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 ( Semaine, [Date] )" _
& " VALUES ('" & SemaineVal & "',#" & Format(idate, "mm/dd/yyyy") & "#)"
DoCmd.RunSQL strsql
Next idate
'Réinitialiser les colonnes (autres que CodeDateSuivi) de T_DateSuivi
DoCmd.RunSQL "UPDATE T_DateSuivi SET T_DateSuivi.Semaine = Null," _
& "T_DateSuivi.Date = Null, T_DateSuivi.CodeDateSuivi_RFP = Null," _
& "T_DateSuivi.CodeDateSuivi_RIM = Null;"
'Regarnir T_DateSuivi avec T_Tampon
'(transfert ligne par ligne, des colonnes de T_Tampon dans T_DateSuivi)
DoCmd.RunSQL "UPDATE T_DateSuivi INNER JOIN T_Tampon " _
& "ON T_DateSuivi.CodeDateSuivi = T_Tampon.CodeDateSuivi " _
& "SET T_DateSuivi.Semaine = [T_Tampon].[Semaine], " _
& "T_DateSuivi.Date = [T_Tampon].[Date], " _
& "T_DateSuivi.CodeDateSuivi_RFP = [T_Tampon].[CodeDateSuivi_RFP], " _
& "T_DateSuivi.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_DateSuivi.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 String
'---------------------------------------------------------------------------------------
' 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 = "Semaine " & bytTemp
Else
Semaine = Null
End If
End Function |
Partager