Exemples d'agenda [Sources]

**User** · 03/06/2009, 00h34

Bonjour,

UN GRAND MERCI POUR TA CONTRIBUTION QUE J'AI INTEGREE A LA DERNIERE VERSION (Agenda v15).
(Il s'agit des couleurs sur les rdv: J'ai juste fait quelques modifs pour le paramétrage, et sur le code, mais l'essentiel reste là)

A l'origine, il s'agit d'une version simplifiée qui accompagnait mon tuto et ne comportant que l'agenda hebdomadaire.

Merci encore de nous faire partager ton expérience (dans le domaine informatique et médical)

Voici la base:
agenda v15

A+

Denis

**hajeahmad** · 15/06/2009, 17h20

Bonjour à tous.

Ci âpres deux petites améliorations de l’agenda. « peuvent peut être servir »
la 1° lors de la prise du Rv sur double click dans une case du formulaire « ( planning_semaine) » vous signale si le jour est férié.

la seconde integre directement le nom du patient en cours dans formulaire « FrmRDVBis»

‘ le formulaire « patients » contient nom, prenom , n°patient etc…
‘ et un bouton intitulé« PrendreRv » avec sur click

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
                         Private Sub   PrendreRV_Click()
                                  RunAgenda
                              Dim p As Variant
                                  MajAgenda
                                 p = Cmd_Planning_Semaine()
                         End sub

‘remplacer la fonction OpenRDV par le code suivant
‘ dans un module inserer la fonction Isloaded et isferie

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
41
42
43
44
45
Private Sub  OpenRDV(i As Integer, j As Integer)
Dim Npatient As string , NomPrenom As string
Dim DateC As Date
Dim sql1 As String
Dim recRV As Recordset
 
   DateC = IndToDate(j, i)
‘**********************   '''''''''''''''''''''''''''''''''''''''''
           If IsFerie(DateC) Then
                 MsgBox " Attention Jour Ferié", vbInformation, "Ferié"
                 Exit Sub
       End If
‘********************** ''''''''''''''''''''''''''''''''''''''''
   sql1 = "SELECT RDV.* " & _
   "FROM RDV " & _
   "WHERE RDV.DateD<=" & FDate(DateC) & " And RDV.DateF>" & FDate(DateC)  
   Set recRV = CurrentDb.OpenRecordset(sql1, dbOpenSnapshot)                    
      If Not (recRV.EOF) Then DateC = recRV!DateD  
   DoCmd.OpenForm "FrmRDVBis", , , "DateD=" & FDate(DateC)   
‘****************************''''''''''''''''''''''''''''''''''''''''''''''''''''''''
        Set Frm = Forms![FrmRDVBis]
            If Not IsNull(Frm!RDV) Then Frm.Caption = Frm!RDV
            If IsNull(Frm!RDV) Then 'If IsNull(ContenuRv) Then
                    If IsLoaded("Patients ") Then
                       Npatient = Forms("Patients")("CustomerID")
                       NomPrenom = Forms("Patients")("NomPat ") & "  "& Forms("Patients")("PrenomPat")
                       Frm!RDV = NomPrenom
                       Frm.Caption = NomPrenom & "  " & Npatient
                    Else
                       NomPrenom = "Nouveau RV"
                       Frm.Caption = NomPrenom & "  " & Npatient
                    End If
            End If 
‘***************************''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   Forms!FrmRDVBis!DateRV = DateC
   Forms!FrmRDVBis!HoraireD = Format(DateC, "hh:nn")
   Forms!FrmRDVBis!DateRV = DateC
   Forms!FrmRDVBis!HoraireD = Format(DateC, "hh:nn")  
      If Not (recRV.EOF) Then
         Forms!FrmRDVBis!HoraireF = Format(recRV!DateF, "hh:nn")
      Else
         Forms!FrmRDVBis!HoraireF = Format(DateAdd("n", 30, DateC), "hh:nn")
      End If  
   recRV.Close  
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
'----------------------------------------------------------------------
' IsLoaded'
'   Returns TRUE if the given form is loaded.
'----------------------------------------------------------------------
Function IsLoaded(FormName)
    IsLoaded = (SysCmd(SYSCMD_GETOBJECTSTATE, A_FORM, FormName) <> 0)
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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
Function IsFerie(Jour As Variant) As Boolean
 'Jours fériés  d'après   Ole P Erlandsen
'Cette fonction permet de savoir si un jour est férié, sans avoir à les gérer dans une table !!
Dim ListeFeries(1 To 11) As Long
Dim tDate As Long, an As Integer
Dim a, b, C, d, e, f, g, h, i, k, l, m, n, p As Integer
Dim Pâques As Date
tDate = CDate(Jour
an = Year(tDate)
a = Int(an Mod 19)
b = Int(an \ 100)
C = Int(an Mod 100)
d = b \ 4
e = b Mod 4
f = (b + 8) \ 25
g = (b - f + 1) \ 3
h = (19 * a + b - d - g + 15) Mod 30
i = C \ 4
k = C Mod 4
l = (32 + 2 * e + 2 * i - h - k) Mod 7
m = (a + 11 * h + 22 * l) \ 451
n = (h + l - 7 * m + 114) \ 31
p = (h + l - 7 * m + 114) Mod 31
Pâques = DateSerial(an, n, p + 1)
IsFerie = False
If tDate < 1 Then Exit Function
If an < 1900 Then Exit Function
'remplit la liste des fériés
ListeFeries(1) = CDate("1/1/" & an) 'Jour de l'An
ListeFeries(2) = DateAdd("d", 1, Pâques)  'Lundi de Pâques
ListeFeries(3) = DateAdd("d", 39, Pâques) 'Jeudi Ascension
ListeFeries(4) = DateAdd("d", 50, Pâques) 'Lundi Pentecôte
ListeFeries(5) = CDate("1/5/" & an) '1er Mai
ListeFeries(6) = CDate("8/5/" & an) '8 Mai
ListeFeries(7) = CDate("14/7/" & an) '14 Juillet
ListeFeries(8) = CDate("15/8/" & an) '15 Août
ListeFeries(9) = CDate("1/11/" & an) 'Toussaint
ListeFeries(10) = CDate("11/11/" & an) '14-18
ListeFeries(11) = CDate("25/12/" & an) 'Noël
' compare la date entrée avec la Liste des Fériés
i = 1
  While i <= UBound(ListeFeries) And IsFerie = False
        If tDate = ListeFeries(i) Then IsFerie = True
        i = i + 1
Wend
End Function

je ne dois pas etre le seul à y avoir pensé

a+

ahmad.

**User** · 16/06/2009, 22h33

Encore merci ahmad pour tes bonnes idées,

Pour les jours fériés je préfère pour ma part afficher en rouge (par exemple) les colonnes correspondant à ces jours sur le planning...

Mais çà reste personnel..

BàT

Denis

**hajeahmad** · 16/06/2009, 23h33

salut Denis

pour faire simple et "pour le fun" j'ai pris en compte tes desiderata
j'ai rajoute une ligne dans la fonction suivante

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
 
Private Sub InitPlanSemaine()
Dim i As Integer, j As Integer
Dim k As Integer
Dim DateC As Date
 
' Initialise le Planning de la semaine
 
For i = 1 To 48
 
   For j = 1 To 7
   Forms!Planning_Semaine!Planning.Form("creneau" & i & "_" & j).Caption = ""
 
      If (i Mod 2) = 1 Then
         Forms!Planning_Semaine!Planning.Form("creneau" & i & "_" & j).BackColor = -2147483624
         Else
         Forms!Planning_Semaine!Planning.Form("creneau" & i & "_" & j).BackColor = vbWhite
      End If
 
   Forms!Planning_Semaine!Planning.Form("creneau" & i & "_" & j).Height = 255
 
   Next j
 
Next i
 
For i = 1 To 7
DateC = DateAdd("d", (i - 1), DatePL)
Forms!Planning_Semaine!Planning.Form("Col" & i).Caption = Format(DateC, "ddd dd mmm yyyy")
 
    If EstWeek(DateC) Then
       Forms!Planning_Semaine!Planning.Form("Col" & i).BackColor = 16761024
       If IsFerie(DateC) Then Forms!Planning_Semaine!Planning.Form("Col" & i).BackColor = 16761087
 
    Else
       Forms!Planning_Semaine!Planning.Form("Col" & i).BackColor = 16761087
    End If
 
Next i
 
End Sub

et ca marche en coloriant en rose l'entete colonne du jour ferié comme pour samedi dimanche

salut et merci encore

ahmad

**hajeahmad** · 17/06/2009, 15h57

re bonjour

pour colorier le jour ferié en rose
Cette methode s’applique aussi au « genialissime » calendrier mensuel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
 
   If m = Month(DateC) Then
      Forms!F_Calendrier("Agenda" & i).BackColor = t((m - 1) Mod 2)
       If IsFerie(DateC) Then Forms!F_Calendrier("Agenda" & i).BackColor = 16761087
   Else
      m = Month(DateC)
      Forms!F_Calendrier("Agenda" & i).BackColor = t((m - 1) Mod 2)
      If IsFerie(DateC) Then Forms!F_Calendrier("Agenda" & i).BackColor = 16761087
   End If

encore bravo et merci Mr Hulo

ahmad

**hajeahmad** · 18/06/2009, 15h29

bonjour.
il y aurait peut etre une piste à explorer si le controle DTpicker est manquant il est normalement fourni avec MSoffice. je me suis deja heurté à ce probleme dans le temps sur un ordi avec access seulement et j'ai du l' installer manuellement
d'abord essaie de debugger en mettant un point d'arret au debut de ta fonction pour voir si ce controle existe et s'il a une valeur si non
telecharge le sur ce lien
http://activex.microsoft.com/controls/vb6/mscomct2.cab

Décompresser le fichier cab
Placer MSCOMCT2.OCX dans c:\windows\System32
puis Menu Démarrer/Exécuter (Taper ou Coller) regsvr32 c:\windows\System32\MSCOMCT2.OCX
Cliquer sur Ok
Le Message "DllRegisterServer dans c:\windows\System32\MSCOMCT2.OCX réussi"
confirme l'installation correcte du composant
sur ce lien il y a une base exemple
http://officesystemaccess.seneque.net/dtpicker.htm

ca devrait marcher.

ahmad

**User** · 19/06/2009, 05h29

Salut RomeooO,

Surtout pour les utilisateurs d'Access 2007, j'ai utilisé le calendrier de Thierry (Arkham46), que j'ai intégré à une nouvelle version:

agenda v17

Normalement maintenant il n'y à aucun composant externe, donc rien à installer.

Ceci dit comme tu débutes, tu risques d'avoir à nouveau des problèmes si tu souhaites adapter l'agenda à tes besoins. Je t'invite donc maintenant à étudier Access, le code VBA.. et à poser tes questions sur les autres forums Access (IHM, VBA Access..) en ouvrant une discussion.

==========================================================

Pour Stagolee,

Une version n°2, avec le contrôle calendrier de Thierry:

gesplan v2 (toute version Access)

ça devrait t'éviter d'avoir des bugs avec le contrôle DTPicker.
(comme je ne connais pas ton code complet, je ne peux pas corriger ton bug)

=======================================================

Bonne continuation.

**naphta** · 22/06/2009, 13h31

Bonjour,

j'ai été très agréablement surpris quand j'ai vu le planning.
Cette partie est formidable, la cerise c'est qu'il a tout pour s'adapter parfaitement aux applis existantes, au niveau de tous les champs.

Rapide, efficace, pragmatique, gooood

Bravo pour cette contrib, je taxe pour des tests in situ
a+

Ps pour le faire fonctionner avec 2007 il faut faire une base vide puis tout importer, pas de conversion.

**User** · 28/07/2009, 22h02

REPONSE A DARIO QUI SOUHAITE CHANGER LES HORAIRES:

Pour changer des horaires de 8h à 18h avec des tranches/creneaux de 15 min
par des horaires de 9h à 20h avec des tranches/créneaux de 30 min.

Changer la liste des horaires dans la table T_Horaire

Puis dans un module faire remplacer dans le projet en cours:

Pour l'horaire de début:

changer 8:00 par 9:00
et (8) par (9)

Pour l'horaire de fin:
remplacer 18:00 par 20:00

Pour la durée créneau/tranche horaire:
remplacer 15 par 30

Pour le nombre de tranches/créneaux:

Remplacer 40 par 22

et dans le SF_Planning
changer les horaires à gauche du planning puis supprimer les créneaux en trop (lignes du bas).

Ce changement ne devrait pas prendre plus de 30 minutes...

Voici la base avec une procedure de sélection des rdv et tranches horaires:
agenda v21

A+

**User** · 25/08/2009, 19h14

Bonjour,

Pour optimiser le code et la mise à jour de l'agenda, remplacer dans la procédure InitPlanning:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
 
   If (i Mod 2) = 1 Then ' on alterne les couleurs de lignes
      Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).BackColor = -2147483624
   Else
      Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).BackColor = vbWhite
   End If

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
   If (i Mod 2) = 1 Then ' on alterne les couleurs de lignes
      If Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).BackColor <> -2147483624 Then
         Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).BackColor = -2147483624
      End If
   Else
      If Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).BackColor <> vbWhite Then
         Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).BackColor = vbWhite
      End If
   End If

Et

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).Height = 295 ' on définit la hauteur des lignes

Par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
 
 
   If Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).Height > 295 Then
      Forms!F_Planning!Planning.Form("creneau" & i & "_" & j).Height = 295 ' on définit la hauteur des lignes
   End If

Ou 295 désigne la hauteur des lignes.

Bonne continuation,

**Tofalu** · 10/11/2009, 23h03

Comme indiqué dans les règles de ce forum, sont autorisé dans celui-ci uniquement les messages de contribution. En aucun cas vous ne devez utiliser le forum Contribuez pour poser vos questions.

User, rédacteur de cette contribution, n'a pas vocation à répondre à vos besoins spécifiques. En cas de problème, merci de créer un nouveau message dans les forums d'entraide IHM ou VBA en détaillant précisément votre problème.

Important :
Si votre message a disparu c'est qu'il a été supprimé à la suite du nettoyage de ce post. Merci de reposter votre demande comme indiqué ci-dessus

Merci de votre compréhension

Exemples d'agenda [Sources]

Contribuez

Discussions similaires

Partager

Partager