Calendrier faire " pop " un message correspondant à un enregistrement
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:
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:
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:
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:
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:
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:
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 |
'
Code:
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 |
ICI dans la prochaine fonction il faudrtait que j'appelle la fonction pour afficher ce qui est égale a la case selectionné.
Code:
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:
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:
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:
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:
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:
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 Function |
Code:
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 |
J’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
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