Discussion :

[jean.philippe4]

Bonjour, je suis nouveau sur le forum et débutant en AccessVBA. j'ai découvert se forum en recherchant des exemple de calendrier. Le travaille qui a déjà été fait sur se calendrier est super bien fait et très bien expliqué. J'aimerais rajouter une récurrence (exemple un RDV a lieux tous les lundi a la même heure), je vois pas trop comment je pourrais rajouter ceci. Peut-être en double clic sur un rdv existant avec un choix de période (de t elle date a t elle date tous les lundi), rajouter une table jour ??? si quelqu'un peu m'aider ? CDT

[User]

Bonjour,

Je n'ai pas le temps de reprendre le fichier Access, mais je peux vous donner un exemple de code VBA permettant d'ajouter ces rendez-vous périodiques à l'aide de recordset :

La fonction de génération des rendez-vous périodiques :

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
Public Function GenererRendezvous(IdRendezVous As Long, DebutRecur As Date, PeriodeJours As Long, NbRecurs As Long) As Boolean
 
    Dim rst1 As DAO.Recordset
    Dim rst2 As DAO.Recordset
    Dim i As Long
 
    ' ouvre les recordset
    Set rst1 = CurrentDb.OpenRecordset("select * from T_Calendrier where IdCalendrier=" & IdRendezVous)
    Set rst2 = CurrentDb.OpenRecordset("T_Calendrier")
 
    ' parcours des récurrences
    For i = 1 To NbRecurs
 
        ' ajout du rendez vous en DebutRecur
        rst2.AddNew
        rst2!DateCalendrier = DebutRecur
        rst2!HeureDebut = rst1!HeureDebut
        rst2!HeureFin = rst1!HeureFin
        rst2!Note = rst1!Note
        rst2!IdPersonne = rst1!IdPersonne
        rst2!IdFiltre = rst1!IdFiltre
        rst2.Update
 
        ' prochaine date de récurrence
        DebutRecur = DebutRecur + PeriodeJours
    Next i
 
    GenererRendezvous = True
 
    rst1.Close
    rst2.Close
 
    Set rst1 = Nothing
    Set rst2 = Nothing
 
End Function

Cette fonction s'utilise comme ceci :

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
Public Function test()
    Dim IdRendezVous As Long, DebutRecur As Date, PeriodeJours As Long, NbRecurs As Long
 
    IdRendezVous = 20 ' identifiant du rendez-vous à ajouter
    DebutRecur = #6/17/2024# ' date de début des ajouts
    PeriodeJours = 7 ' période en jours : semaine = 7 jours
    NbRecurs = 5 ' nombre de récurrences
 
    ' exécution de la fonction
    If GenererRendezvous(IdRendezVous, DebutRecur, PeriodeJours, NbRecurs) Then
        ' Si la fonction retourne True
        MsgBox "Rendez-vous ajoutés !", vbExclamation
    End If
 
End Function

Cdlt,