[AC-2007] Afficher et archiver les durées des sessions

[Triton972]

Bonjour,

Cela fait longtemps que je voulais savoir combien de temps je passais sur le développement et l'utilisation d'application sous ACCESS. Le chronomètre c'est pas très souple j'ai donc développé un petit module qui permet de répondre à mes souhaits.
L'application s'articule autour d'un programme "Session.accdb" qui sera déclaré comme référence dans chacune des applications que l'on souhaite suivre.
Dans "Session.accdb" on trouvera :
1 Table : T0_SES. Elle archive toutes les sessions en cours d'utilisation ou déjà fermées. Les données stockées sont :

- Le nom de l'application
- Le nom de l'utilisateur
- Le nom de l'ordinateur
- La date et l'heure d'ouverture de l'application
- La date et l'heure de fermeture de l'application
- La durée de la session en heures, minutes et secondes

2 requêtes sous-jacentes à 2 formulaires de visualisation.
1 Formulaire "F4_SES1" qui visualise toutes les sessions avec un cumul total des durées
1 Formulaire "F4_SES2" qui présente les durées cumulées par jour.

Ces 2 formulaires sont des exemples de visualisation, on peut en faire d'autres.

et 1 code ...

Il permet :
- D'alimenter la table T0_SES à l'ouverture et la fermeture des applications suivies (on verra comment par la suite)
- De calculer et de formater les calculs de durée
- De modifier et de rafraichir régulièrement le titre de l'application et y intégrant la durée actuelle de la session (on utilise le Timer dans chaque application suivie)

Dans chaque application suivie, il y a quelques opérations à réaliser :

- Lier la table T0_SES en pointant sur "Session.accdb"
(Nota : Je n'ai pas trouvé d'astuce pour pouvoir mettre à jour directement la table d'un programme identifié comme "Référence" ...)
- Incorporer 2 formulaires (F0_DEM1 et F0_DEM). L'idée est de pouvoir déclencher systématiquement des évènements en début et en fin de session indépendamment de l'application concernée. Ces opérations doivent être complétement transparentes pour l'utilisateur.
Le formulaire "F0_DEM" va rester ouvert (et masqué) pendant toute la session.
Comme on ne peut pas affecter la propriété "Visible" à False pour le formulaire actif, je passe par un autre formulaire "F0_DEM1" dont le seul but est de lancer "F0_DEM" en mode "caché". (Il y a peut-être une autre méthode plus simple ?...). C'est donc le formulaire qui faut lancer au démarrage : Soit par les options de la base de données active soit en lançant ce formulaire à partir du 1° formulaire ouvert (Menu principal ...)

Ci-après le code de "F0_DEM1"

Code :

1
2
3
Private Sub Form_Load()
DoCmd.OpenForm "F0_DEM", acNormal, , , , acHidden
End Sub

Ci-après le code de "F0_DEM"

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Option Compare Database
Private Sub Form_Load()
DoCmd.Close acForm, "F0_DEM1"
Ouvre_Ses CurrentProject.Name
Change_TitreApplication (CurrentProject.Name)
End Sub
 
Private Sub Form_Timer()
Change_TitreApplication (CurrentProject.Name & " - " & DureeSES(CurrentProject.Name))
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
Ferme_Ses CurrentProject.Name
End Sub

On voit que la 1° action est de fermer "F0_DEM1", ensuite on appelle la fonction Ouvre_Ses avec comme paramètre

Code :

CurrentProject.Name

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
Public Function Ouvre_Ses(stAppl As String) As Integer
Dim rst As DAO.Recordset
Dim stReq As String
Dim stCrit As String
On Error GoTo Erreur
 
Ouvre_Ses = False
 
Ferme_Ses stAppl    ' On vérifie que la session précédente est bien fermée, sinon on la ferme
 
stReq = "T0_SES"
Set rst = CurrentDb.OpenRecordset(stReq, dbOpenDynaset)
rst.AddNew
rst("C_SES_APPL") = stAppl
rst("C_SES_DEB") = Now
rst("C_SES_UTIL") = Nz(Environ$("username"))
rst("C_SES_ORDI") = Nz(Environ$("computername"))
 
rst.Update
 
Ouvre_Ses = True
rst.Close
Set rst = Nothing
Exit Function
 
Erreur:
End Function

Puis on appelle la fonction qui permet de changer le titre de l'application

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
Public Sub Change_TitreApplication(stTitre As String)
'Pour une première utilisation, cette propriété n'est pas définie et son utilisation
 'provoque l'erreur rattrapable n°3270 : "Propriété non trouvée"
 'Il convient alors de créer la propriété dans le code de gestion d'erreur
 
On Error GoTo Erreur
 
    Dim prp As DAO.Property
 
    CurrentDb.Properties("AppTitle") = stTitre
    RefreshTitleBar
    Exit Sub
 
Erreur:
    If Err.Number = 3270 Then
        Set prp = CurrentDb.CreateProperty("AppTitle", dbText, stTitre)
        CurrentDb.Properties.Append prp
        Resume
    End If
 
End Sub

L'évènement "Timer" (j'ai paramétré l'intervalle de minuterie à 60000, soit un rafraichissement de l'affichage toutes les minutes) permettra d'afficher le nom de l'application avec la durée actuelle de la session en utilisant la fonction "DureeSES" (et ses sous-fonctions)

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
Public Function DureeSES(stAppl As String) As String
Dim dtDateDeb As Date
DureeSES = ""
On Error GoTo Erreur
dtDateDeb = Nz(DLookup("C_SES_DEB", "T0_SES", "((isnull([C_SES_FIN])) AND ([C_SES_APPL]= '" & stAppl & "'))"))
DureeSES = DureeSt(dtDateDeb, Now)
Erreur:
End Function 
 
Function DureeSt(dtDateDeb As Date, dtDateFin As Date) As String
DureeSt = DureeSt1(DateDiff("s", dtDateDeb, dtDateFin, vbMonday))
End Function
 
Function DureeSt1(lgDuree As Long) As String
Dim intH As Long
Dim intM As Long
Dim intS As Long
Dim intD As Long
 
intD = lgDuree
intH = Int(intD / 3600)
intM = Int((intD - (3600 * intH)) / 60)
intS = intD - (3600 * intH) - (60 * intM)
 
DureeSt1 = intH & " h " & intM & " min " & intS & " s"
End Function

Enfin à la fermeture du formulaire (qui surviendra lors de la fermeture de l'application) on déclenche la fonction "Ferme_Ses" qui vient mettre à jour la table T0_SES avec la date et heure de fin

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
Public Function Ferme_Ses(stAppl As String) As Integer
Dim rst As DAO.Recordset
Dim stReq As String
Dim stCrit As String
On Error GoTo Erreur
 
Ferme_Ses = False
stReq = "T0_SES"
stCrit = "((isnull([C_SES_FIN])) AND ([C_SES_NSES]= " & LitNSES(stAppl) & "))"
 
Set rst = CurrentDb.OpenRecordset(stReq, dbOpenDynaset)
    If Not rst.EOF Then
        rst.FindFirst stCrit
            If Not rst.NoMatch Then
                rst.Edit
                rst("C_SES_FIN") = Now
                rst.Update
                Ferme_Ses = True
            End If
    End If
rst.Close
Set rst = Nothing
Exit Function
Erreur:
 
End Function
 
Public Function LitNSES(stAppl As String) As Long
LitNSES = 0
On Error GoTo Erreur
LitNSES = Nz(DLookup("C_SES_NSES", "T0_SES", "((isnull([C_SES_FIN])) AND ([C_SES_APPL]= '" & stAppl & "'))"))
Erreur:
End Function

Je joins en fichier joint le programme complet (Session.accdb). Les 2 formulaires "F0_DEM" et "F0_DEM1" sont contenus dans le même fichier.

Je reste à l'écoute pour les bugs (éventuels), les améliorations ou les commentaires.
Cordialement,