Bonjour,
J’ai besoin de vous
Je suis entrain de réaliser un planning a base d’étiquètes (lundi, mardi…) + jour (numéro du jour 1, 2,3…) cette partie la pas de problème (sous access 2003).
J’ai une base de données où il y a des dates et je voudrais que lorsque l’on clique sur le jour cela fasse pop l’enregistrement qui est égale à la date
Je ne sais pas si c’est bien clair donc je vais faire un exemple :
Dans ma base de données, j’ai la date du 2 avril 2009, je voudrais que lorsque je clique sur mon planning du Jeudi 2 avril 2009 cela me fasse pop (en msgbox je pense) l’enregistrement de ma base de données qui est égale au 2 avril 2009. Si je clique sur la case du vendredi 3 avril que cela me fasse pop l'enregistrement du 3 avril etc.. Il se peut qu'il n'y ai pas d'enregistrement dans ma base qui soit égale a la date sélectionné donc a ce moment là je retournerais "Rien de prevu".
je me suis inspiré de plusieurs tuto trouvé a droite a gauche je vous colle le code source.
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 '/!\PLANNING + DATE /!\ Private Sub Liste_Annee_AfterUpdate() 'On réactualise le titre (mois + année) Me.MonthYear.Caption = Me.Liste_Mois.Column(1) & " " & Me.Liste_Annee Dim Num As Integer, i As Integer Num = Me.Liste_Jour.OldValue 'On réactualise la liste des jours (pour les années bissextiles !) Me.Liste_Jour.RowSource = "" For i = 1 To Nbjour_mois(Liste_Mois, Liste_Annee) Me.Liste_Jour.AddItem (i) Next 'Si le mois qui été selectionné précédemment possède plus de jour que le mois que l'on vient de choisir, on prend le dernier jour de ce dernier '(exemple :date sélectionnée = '31/03/07', mois que l'on va sélectionner = 'xx/02/07', on aura '28/02/07' If Me.Liste_Jour.ItemData(Num - 1) > Nbjour_mois(Me.Liste_Mois, Me.Liste_Annee) Then Me.Liste_Jour = Me.Liste_Jour.ItemData(Nbjour_mois(Me.Liste_Mois, Me.Liste_Annee) - 1) Else Me.Liste_Jour = Me.Liste_Jour.ItemData(Num - 1) 'On réactualise le numéro de semaine Me.WeekNum.Caption = "Semaine " & DatePart("ww", DateSerial(Me.Liste_Annee, Me.Liste_Mois, Me.Liste_Jour), vbMonday, vbFirstFourDays) 'On réinitialise le calcul des jours (jours associés à la date) CalculJours End Sub
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 Private Sub Liste_Mois_Change() 'On réactualise le titre (mois + année) Me.MonthYear.Caption = Me.Liste_Mois.Column(1) & " " & Me.Liste_Annee Dim Num As Integer, i As Integer Num = Me.Liste_Jour.OldValue 'On réactualise la liste des jours Me.Liste_Jour.RowSource = "" For i = 1 To Nbjour_mois(Liste_Mois, Liste_Annee) Me.Liste_Jour.AddItem (i) Next 'Si le mois qui été selectionné précédemment possède plus de jour que le mois que l'on vient de choisir, on prend le dernier jour de ce dernier '(exemple :date sélectionnée = '31/03/07', mois que l'on va sélectionner = 'xx/02/07', on aura '28/02/07' If Me.Liste_Jour > Nbjour_mois(Me.Liste_Mois, Me.Liste_Annee) Then Me.Liste_Jour = Me.Liste_Jour.ItemData(Nbjour_mois(Me.Liste_Mois, Me.Liste_Annee) - 1) Else Me.Liste_Jour = Num End If 'On réactualise le numéro de semaine Me.WeekNum.Caption = "Semaine " & DatePart("ww", DateSerial(Me.Liste_Annee, Me.Liste_Mois, Me.Liste_Jour), vbMonday, vbFirstFourDays) 'On réinitialise le calcul des jours (jours associés à la date) CalculJours End Sub
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7 Private Sub Liste_jour_Change() 'On réactualise le numéro de semaine Me.WeekNum.Caption = "Semaine " & DatePart("ww", DateSerial(Me.Liste_Annee, Me.Liste_Mois, Me.Liste_Jour), vbMonday, vbFirstFourDays) 'On réinitialise le calcul des jours (jours associés à la date) CalculJours End Sub
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 Private Sub Previous_Click() Dim date_prec As Date date_prec = DateAdd("ww", -1, DateSerial(Me.Liste_Annee, Me.Liste_Mois, Me.Liste_Jour)) 'On sélectionne la semaine qui précède la semaine en cours Liste_Annee = Liste_Annee.ItemData(CInt(Year(date_prec)) - 1900) Liste_Mois = Liste_Mois.ItemData(CInt(Month(date_prec)) - 1) Dim Num As Integer, i As Integer Num = Me.Liste_Jour.OldValue 'On réactualise la liste des jours Me.Liste_Jour.RowSource = "" For i = 1 To Nbjour_mois(Liste_Mois, Liste_Annee) Me.Liste_Jour.AddItem (i) Next Me.Liste_Jour = Liste_Jour.ItemData(CInt(Day(date_prec)) - 1) 'On réactualise le titre (mois + année) Me.MonthYear.Caption = Me.Liste_Mois.Column(1) & " " & Me.Liste_Annee 'On réactualise le numéro de semaine Me.WeekNum.Caption = "Semaine " & DatePart("ww", DateSerial(Me.Liste_Annee, Me.Liste_Mois, Me.Liste_Jour), vbMonday, vbFirstFourDays) 'On réinitialise le calcul des jours (jours associés à la date) CalculJours End Sub
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 Private Sub Next_Click() Dim date_prec As Date date_prec = DateAdd("ww", 1, DateSerial(Me.Liste_Annee, Me.Liste_Mois, Me.Liste_Jour)) 'On sélectionne la semaine qui précède la semaine en cours Liste_Annee = Liste_Annee.ItemData(CInt(Year(date_prec)) - 1900) Liste_Mois = Liste_Mois.ItemData(CInt(Month(date_prec)) - 1) Dim Num As Integer, i As Integer Num = Me.Liste_Jour.OldValue 'On réactualise la liste des jours Me.Liste_Jour.RowSource = "" For i = 1 To Nbjour_mois(Liste_Mois, Liste_Annee) Me.Liste_Jour.AddItem (i) Next Me.Liste_Jour = Liste_Jour.ItemData(CInt(Day(date_prec)) - 1) 'On réactualise le titre (mois + année) Me.MonthYear.Caption = Me.Liste_Mois.Column(1) & " " & Me.Liste_Annee 'On réactualise le numéro de semaine Me.WeekNum.Caption = "Semaine " & DatePart("ww", DateSerial(Me.Liste_Annee, Me.Liste_Mois, Me.Liste_Jour), vbMonday, vbFirstFourDays) 'On réinitialise le calcul des jours (jours associés à la date) CalculJours End Sub'
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 'Procédure évènementielle de chaque case du calendrier 'Lorsque l'on clique, on rend la couleur et l'aspect d'origine à la case qui était selectionnée avant 'et on donne l'aspect "appuyé" et la couleur de fond à la case "en cour" Private Sub J1_Click() If Me.J1.SpecialEffect = 0 Then SelectDay (1) End If End Sub Private Sub J2_Click() If Me.J2.SpecialEffect = 0 Then SelectDay (2) End If End Sub Private Sub J3_Click() If Me.J3.SpecialEffect = 0 Then SelectDay (3) End If End Sub Private Sub J4_Click() If Me.J4.SpecialEffect = 0 Then SelectDay (4) End If End Sub Private Sub J5_Click() If Me.J5.SpecialEffect = 0 Then SelectDay (5) End If End Sub Private Sub J6_Click() If Me.J6.SpecialEffect = 0 Then SelectDay (6) End If End Sub Private Sub J7_Click() If Me.J7.SpecialEffect = 0 Then SelectDay (7) End If End Sub
ICI dans la prochaine fonction il faudrtait que j'appelle la fonction pour afficher ce qui est égale a la case selectionné.
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 Cette fonction permet le calcul des dates par jour, une fois le premier jour du mois ainsi que "sa case" ait été détectés, 'on remplit les premières cases avec les numéros des jours du mois précédent, puis on continue avec les cases du mois en cours 'pour finir avec les jours du mois suivant Private Function CalculJours() Dim i As Integer Dim DateDebutSemaine As Date Dim k As Integer 'On calcule le numéro du premier jour de la semaine selon la date selectionnée grâce aux listes DateDebutSemaine = DateAdd("d", -IIf(Weekday(DateSerial(Me.Liste_Annee, Me.Liste_Mois, Me.Liste_Jour)) - 1 = 0, 7, Weekday(DateSerial(Me.Liste_Annee, Me.Liste_Mois, Me.Liste_Jour)) - 1) + 1, DateSerial(Me.Liste_Annee, Me.Liste_Mois, Me.Liste_Jour)) 'Pour chaque jours de la semaine For i = 0 To 6 'On affecte à la case en cours le numéro de son jour NumObject(i + 1).Caption = Day(DateAdd("d", i, DateDebutSemaine)) 'Et on colore la police des cases du mois en cours différemment des cases du mois précédent et suivant If CInt(Month(DateAdd("d", i, DateDebutSemaine))) <> Liste_Mois Then NumObject(i + 1).ForeColor = 8421504 Else NumObject(i + 1).ForeColor = 10485760 End If 'On colore l'arrière plan des cases qui sont des samedi, dimanche, ou des jours fériés If (i = 5) Or (i = 6) Or IsFerie(DateAdd("d", i, DateDebutSemaine)) Then NumObject(i + 1).BackColor = NotWorkedColor Else NumObject(i + 1).BackColor = NormalColor End If Next 'Dans le cas d'une case "WE" ou fériée, on sauvegarde la bonne couleur If ((CInt(elem_selected.Caption) = 6) Or (CInt(elem_selected.Caption) = 7)) Then text_color_old = NotWorkedColor Else text_color_old = elem_selected.BackColor End If 'On donne au bouton selectionné les attributs de la selection (couleur, aspect, etc...) elem_selected.BackColor = SelectColor End Function
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12 Public Function SelectDay(num_case As Integer) DeSelectPreviousDay 'Sauvegarde de la couleur de la case text_color_old = NumObject(num_case).BackColor NumObject(num_case).BackColor = SelectColor NumObject(num_case).SpecialEffect = 2 'Mise à jour de la variable case en cour de sélection Set elem_selected = NumObject(num_case) 'Appeler la fonction RetournerAffichage 'Appeler la fonction RetournerAffichage 'Appeler la fonction RetournerAffichage End Function
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5 Private Function DeSelectPreviousDay() elem_selected.SpecialEffect = 0 elem_selected.BackColor = text_color_old Set elem_selected = Nothing End Function
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 'Cette fonction permet de contourner l'interdiction d'avoir une variable tableau public 'Elle retourne un objet qui désigne une case du calendrier en fonction de sa position (facilement calculable) Private Function NumObject(j As Integer) As Object Dim Bouton_Jour(42) As Object 'On initialise le tableau d'objets Set Bouton_Jour(1) = Me.J1 Set Bouton_Jour(2) = Me.J2 Set Bouton_Jour(3) = Me.J3 Set Bouton_Jour(4) = Me.J4 Set Bouton_Jour(5) = Me.J5 Set Bouton_Jour(6) = Me.J6 Set Bouton_Jour(7) = Me.J7 'On retourne l'objet correspondant au paramètre Set NumObject = Bouton_Jour(j) End Function
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 'Fonction inverse Private Function ObjectNum(Bouton_Jour As Object) As Integer 'On initialise le tableau d'objets With Bouton_Jour Select Case Bouton_Jour.Name Case "J1" ObjectNum = 1 Case "J2" ObjectNum = 2 Case "J3" ObjectNum = 3 Case "J4" ObjectNum = 4 Case "J5" ObjectNum = 5 Case "J6" ObjectNum = 6 Case "J7" ObjectNum = 7 End Select End With End Function
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 Private Function IsFerie(Date_testee As Date) As Boolean Dim JJ As Integer, AA As Integer, MM As Integer Dim NbOr As Integer, Epacte As Integer Dim PLune As Date, Paques As Date, Ascension As Date, Pentecote As Date JJ = Day(Date_testee) MM = Month(Date_testee) AA = Year(Date_testee) If JJ = 1 And MM = 1 Then IsFerie = True: Exit Function '1 Janvier If JJ = 1 And MM = 5 Then IsFerie = True: Exit Function '1 Mai If JJ = 8 And MM = 5 Then IsFerie = True: Exit Function '8 Mai If JJ = 14 And MM = 7 Then IsFerie = True: Exit Function '14 Juillet If JJ = 15 And MM = 8 Then IsFerie = True: Exit Function '15 Août If JJ = 1 And MM = 11 Then IsFerie = True: Exit Function '1 Novembre If JJ = 11 And MM = 11 Then IsFerie = True: Exit Function '11 Novembre If JJ = 25 And MM = 12 Then IsFerie = True: Exit Function '25 Décembre NbOr = (AA Mod 19) + 1 Epacte = (11 * NbOr - (3 + Int((2 + Int(AA / 100)) * 3 / 7))) Mod 30 PLune = DateSerial(AA, 4, 19) - ((Epacte + 6) Mod 30) If Epacte = 24 Then PLune = PLune - 1 If Epacte = 25 And (AA >= 1900 And AA < 2000) Then PLune = PLune - 1 Paques = PLune - Weekday(PLune) + vbMonday + 7 'Paques If JJ = Day(Paques) And MM = Month(Paques) Then IsFerie = True: Exit Function Ascension = Paques + 38 'Ascension If JJ = Day(Ascension) And MM = Month(Ascension) Then IsFerie = True: Exit Function Pentecote = Ascension + 11 'Pentecote If JJ = Day(Pentecote) And MM = Month(Pentecote) Then IsFerie = True: Exit Function IsFerie = False End Function
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14 'Fonction qui retourne le numéro de la semaine selon une date donnée Private Function NumeroSemaine(date_jour As Date) As Integer 'Algorithme adapté à vb trouvé sur http://www.univ-lemans.fr/~hainry/articles/semaine.html Dim i As Integer, j As Integer, N As Integer, S As Integer, A As Integer N = 0 For i = 1 To CInt(Month(date_jour)) - 1 N = N + Nbjour_mois(i, CInt(Year(date_jour))) Next N = N + CInt(Day(date_jour)) S = Fix(CInt(Year(Date)) / 100) A = CInt(Year(Date)) - S If Not EstBissextile(Year(Date)) Then j = (5 * S + S / 4 + A + A / 4) Mod 7 Else j = (5 * S + S / 4 + A + A / 4 + 6) Mod 7 NumeroSemaine = (j + N + 5) / 7 - (j / 5) End FunctionJ’aimerais faire une fonction du style RetournerAffichage qui me retournerait l’enregistrement qui serait égale à la sélection de ma case du planning comme dans l’exemple cité plus haut
Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7 'Fonction qui retourne le nombre de jour par mois (années bissextiles prises en compte) Private Function Nbjour_mois(Mois As Integer, Annee As Integer) As Integer Nbjour_mois = IIf(Mois > 7, 31 - Mois Mod 2, 30 + Mois Mod 2) If Mois = 2 Then Nbjour_mois = 28 + Sgn(IIf((Annee Mod 100) = 0, Annee Mod 400, Annee Mod 4)) Xor 1 End If End Function
Donc je ne sais pas comment mit prendre faut-il que je fasse une requête ? Du code ?
Je vous remercie par avance de votre aide
Partager