StillHammer
fe30e811a3
- Structure projet complete - Schema BDD (3 tables: Clients, Projets, Temps) - 6 modules VBA documentes - Scripts SQL de creation - Plan d'implementation pour agent - Base Access avec tables creees (Phase 1 complete) 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
827 lines
32 KiB
Markdown
827 lines
32 KiB
Markdown
# TimeTrack Pro - Documentation Modules VBA
|
|
|
|
## Architecture
|
|
|
|
```
|
|
┌─────────────────────────────────────────────────────────────┐
|
|
│ FORMULAIRES │
|
|
│ frm_Accueil frm_Clients frm_Projets frm_Temps etc. │
|
|
└─────────────────────────────────────────────────────────────┘
|
|
│
|
|
▼
|
|
┌─────────────────────────────────────────────────────────────┐
|
|
│ mod_Navigation │
|
|
│ OpenFormClients(), CloseAllForms(), etc. │
|
|
└─────────────────────────────────────────────────────────────┘
|
|
│
|
|
▼
|
|
┌─────────────────────────────────────────────────────────────┐
|
|
│ mod_DataAccess │
|
|
│ GetClients(), SaveProjet(), DeleteTemps(), etc. │
|
|
└─────────────────────────────────────────────────────────────┘
|
|
│
|
|
┌───────────────┼───────────────┐
|
|
▼ ▼ ▼
|
|
┌───────────────────┐ ┌───────────────┐ ┌───────────────┐
|
|
│ mod_Calculs │ │ mod_Export │ │ mod_Utils │
|
|
│ TotalHeures() │ │ ExportPDF() │ │ FormatDate() │
|
|
│ MontantProjet() │ │ ExportExcel() │ │ ValidEmail() │
|
|
└───────────────────┘ └───────────────┘ └───────────────┘
|
|
│
|
|
▼
|
|
┌───────────────────────────────┐
|
|
│ mod_Config │
|
|
│ APP_NAME, VERSION, etc. │
|
|
└───────────────────────────────┘
|
|
```
|
|
|
|
---
|
|
|
|
## mod_Config
|
|
|
|
Constantes et parametres globaux de l'application.
|
|
|
|
```vba
|
|
'===============================================================================
|
|
' Module: mod_Config
|
|
' Description: Constantes et parametres globaux de TimeTrack Pro
|
|
' Auteur: Alexis Trouve
|
|
' Date: 2025-12-30
|
|
'===============================================================================
|
|
Option Compare Database
|
|
Option Explicit
|
|
|
|
' Application
|
|
Public Const APP_NAME As String = "TimeTrack Pro"
|
|
Public Const APP_VERSION As String = "1.0.0"
|
|
|
|
' Chemins
|
|
Public Const EXPORT_PATH As String = "C:\TimeTrack\Exports\"
|
|
Public Const BACKUP_PATH As String = "C:\TimeTrack\Backups\"
|
|
|
|
' Formats
|
|
Public Const DATE_FORMAT As String = "dd/mm/yyyy"
|
|
Public Const TIME_FORMAT As String = "0.00"
|
|
Public Const CURRENCY_FORMAT As String = "#,##0.00 €"
|
|
|
|
' Valeurs par defaut
|
|
Public Const DEFAULT_TAUX_HORAIRE As Currency = 50
|
|
Public Const DEFAULT_DUREE As Double = 1
|
|
|
|
' Messages
|
|
Public Const MSG_CONFIRM_DELETE As String = "Voulez-vous vraiment supprimer cet element ?"
|
|
Public Const MSG_SAVE_SUCCESS As String = "Enregistrement reussi."
|
|
Public Const MSG_ERROR_GENERIC As String = "Une erreur s'est produite."
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Fonction: GetAppTitle
|
|
' Description: Retourne le titre complet de l'application
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetAppTitle() As String
|
|
GetAppTitle = APP_NAME & " v" & APP_VERSION
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Fonction: EnsureFoldersExist
|
|
' Description: Cree les dossiers necessaires s'ils n'existent pas
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub EnsureFoldersExist()
|
|
On Error Resume Next
|
|
MkDir EXPORT_PATH
|
|
MkDir BACKUP_PATH
|
|
On Error GoTo 0
|
|
End Sub
|
|
```
|
|
|
|
---
|
|
|
|
## mod_Navigation
|
|
|
|
Gestion de la navigation entre formulaires.
|
|
|
|
```vba
|
|
'===============================================================================
|
|
' Module: mod_Navigation
|
|
' Description: Fonctions de navigation entre formulaires
|
|
' Auteur: Alexis Trouve
|
|
' Date: 2025-12-30
|
|
'===============================================================================
|
|
Option Compare Database
|
|
Option Explicit
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: OpenFormAccueil
|
|
' Description: Ouvre le formulaire d'accueil
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub OpenFormAccueil()
|
|
DoCmd.OpenForm "frm_Accueil"
|
|
End Sub
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: OpenFormClients
|
|
' Description: Ouvre le formulaire de gestion des clients
|
|
' Params: Optional clientID - ID du client a selectionner
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub OpenFormClients(Optional ByVal clientID As Long = 0)
|
|
DoCmd.OpenForm "frm_Clients"
|
|
If clientID > 0 Then
|
|
Forms!frm_Clients.Recordset.FindFirst "ClientID = " & clientID
|
|
End If
|
|
End Sub
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: OpenFormProjets
|
|
' Description: Ouvre le formulaire de gestion des projets
|
|
' Params: Optional clientID - Filtrer par client
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub OpenFormProjets(Optional ByVal clientID As Long = 0)
|
|
Dim strFilter As String
|
|
|
|
If clientID > 0 Then
|
|
strFilter = "ClientID = " & clientID
|
|
DoCmd.OpenForm "frm_Projets", , , strFilter
|
|
Else
|
|
DoCmd.OpenForm "frm_Projets"
|
|
End If
|
|
End Sub
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: OpenFormSaisieTemps
|
|
' Description: Ouvre le formulaire de saisie de temps
|
|
' Params: Optional projetID - Pre-selectionner un projet
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub OpenFormSaisieTemps(Optional ByVal projetID As Long = 0)
|
|
DoCmd.OpenForm "frm_SaisieTemps"
|
|
If projetID > 0 Then
|
|
Forms!frm_SaisieTemps!cboProjet = projetID
|
|
End If
|
|
End Sub
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: OpenFormHistorique
|
|
' Description: Ouvre le formulaire d'historique des temps
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub OpenFormHistorique()
|
|
DoCmd.OpenForm "frm_Historique"
|
|
End Sub
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: CloseCurrentForm
|
|
' Description: Ferme le formulaire actif
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub CloseCurrentForm()
|
|
DoCmd.Close acForm, Screen.ActiveForm.Name
|
|
End Sub
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: CloseAllForms
|
|
' Description: Ferme tous les formulaires ouverts
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub CloseAllForms()
|
|
Dim frm As Form
|
|
For Each frm In Forms
|
|
DoCmd.Close acForm, frm.Name
|
|
Next frm
|
|
End Sub
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: RefreshCurrentForm
|
|
' Description: Rafraichit le formulaire actif
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub RefreshCurrentForm()
|
|
Screen.ActiveForm.Requery
|
|
End Sub
|
|
```
|
|
|
|
---
|
|
|
|
## mod_DataAccess
|
|
|
|
Fonctions CRUD pour l'acces aux donnees.
|
|
|
|
```vba
|
|
'===============================================================================
|
|
' Module: mod_DataAccess
|
|
' Description: Fonctions CRUD pour acces aux donnees
|
|
' Auteur: Alexis Trouve
|
|
' Date: 2025-12-30
|
|
'===============================================================================
|
|
Option Compare Database
|
|
Option Explicit
|
|
|
|
'===============================================================================
|
|
' CLIENTS
|
|
'===============================================================================
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetClients
|
|
' Description: Retourne un recordset de tous les clients
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetClients() As DAO.Recordset
|
|
Set GetClients = CurrentDb.OpenRecordset( _
|
|
"SELECT * FROM tbl_Clients ORDER BY Nom", dbOpenDynaset)
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetClientByID
|
|
' Description: Retourne un client par son ID
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetClientByID(ByVal clientID As Long) As DAO.Recordset
|
|
Set GetClientByID = CurrentDb.OpenRecordset( _
|
|
"SELECT * FROM tbl_Clients WHERE ClientID = " & clientID, dbOpenDynaset)
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: SaveClient
|
|
' Description: Sauvegarde un client (insert ou update)
|
|
' Returns: ID du client
|
|
'-------------------------------------------------------------------------------
|
|
Public Function SaveClient(ByVal nom As String, _
|
|
Optional ByVal email As String = "", _
|
|
Optional ByVal telephone As String = "", _
|
|
Optional ByVal notes As String = "", _
|
|
Optional ByVal clientID As Long = 0) As Long
|
|
Dim sql As String
|
|
|
|
If clientID = 0 Then
|
|
' INSERT
|
|
sql = "INSERT INTO tbl_Clients (Nom, Email, Telephone, Notes, DateCreation) " & _
|
|
"VALUES ('" & EscapeSQL(nom) & "', '" & EscapeSQL(email) & "', " & _
|
|
"'" & EscapeSQL(telephone) & "', '" & EscapeSQL(notes) & "', Now())"
|
|
CurrentDb.Execute sql, dbFailOnError
|
|
SaveClient = DMax("ClientID", "tbl_Clients")
|
|
Else
|
|
' UPDATE
|
|
sql = "UPDATE tbl_Clients SET " & _
|
|
"Nom = '" & EscapeSQL(nom) & "', " & _
|
|
"Email = '" & EscapeSQL(email) & "', " & _
|
|
"Telephone = '" & EscapeSQL(telephone) & "', " & _
|
|
"Notes = '" & EscapeSQL(notes) & "' " & _
|
|
"WHERE ClientID = " & clientID
|
|
CurrentDb.Execute sql, dbFailOnError
|
|
SaveClient = clientID
|
|
End If
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: DeleteClient
|
|
' Description: Supprime un client (et ses projets/temps en cascade)
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub DeleteClient(ByVal clientID As Long)
|
|
' Supprimer temps des projets du client
|
|
CurrentDb.Execute "DELETE FROM tbl_Temps WHERE ProjetID IN " & _
|
|
"(SELECT ProjetID FROM tbl_Projets WHERE ClientID = " & clientID & ")"
|
|
|
|
' Supprimer projets du client
|
|
CurrentDb.Execute "DELETE FROM tbl_Projets WHERE ClientID = " & clientID
|
|
|
|
' Supprimer client
|
|
CurrentDb.Execute "DELETE FROM tbl_Clients WHERE ClientID = " & clientID
|
|
End Sub
|
|
|
|
'===============================================================================
|
|
' PROJETS
|
|
'===============================================================================
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetProjets
|
|
' Description: Retourne les projets (optionnellement filtres par client)
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetProjets(Optional ByVal clientID As Long = 0, _
|
|
Optional ByVal actifsOnly As Boolean = True) As DAO.Recordset
|
|
Dim sql As String
|
|
sql = "SELECT p.*, c.Nom AS ClientNom FROM tbl_Projets p " & _
|
|
"INNER JOIN tbl_Clients c ON p.ClientID = c.ClientID WHERE 1=1"
|
|
|
|
If clientID > 0 Then
|
|
sql = sql & " AND p.ClientID = " & clientID
|
|
End If
|
|
|
|
If actifsOnly Then
|
|
sql = sql & " AND p.Actif = True"
|
|
End If
|
|
|
|
sql = sql & " ORDER BY c.Nom, p.Nom"
|
|
|
|
Set GetProjets = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: SaveProjet
|
|
' Description: Sauvegarde un projet
|
|
'-------------------------------------------------------------------------------
|
|
Public Function SaveProjet(ByVal clientID As Long, _
|
|
ByVal nom As String, _
|
|
Optional ByVal description As String = "", _
|
|
Optional ByVal tauxHoraire As Currency = 0, _
|
|
Optional ByVal actif As Boolean = True, _
|
|
Optional ByVal projetID As Long = 0) As Long
|
|
Dim sql As String
|
|
|
|
If projetID = 0 Then
|
|
sql = "INSERT INTO tbl_Projets (ClientID, Nom, Description, TauxHoraire, Actif, DateCreation) " & _
|
|
"VALUES (" & clientID & ", '" & EscapeSQL(nom) & "', '" & EscapeSQL(description) & "', " & _
|
|
tauxHoraire & ", " & IIf(actif, "True", "False") & ", Now())"
|
|
CurrentDb.Execute sql, dbFailOnError
|
|
SaveProjet = DMax("ProjetID", "tbl_Projets")
|
|
Else
|
|
sql = "UPDATE tbl_Projets SET " & _
|
|
"ClientID = " & clientID & ", " & _
|
|
"Nom = '" & EscapeSQL(nom) & "', " & _
|
|
"Description = '" & EscapeSQL(description) & "', " & _
|
|
"TauxHoraire = " & tauxHoraire & ", " & _
|
|
"Actif = " & IIf(actif, "True", "False") & " " & _
|
|
"WHERE ProjetID = " & projetID
|
|
CurrentDb.Execute sql, dbFailOnError
|
|
SaveProjet = projetID
|
|
End If
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: DeleteProjet
|
|
' Description: Supprime un projet et ses entrees de temps
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub DeleteProjet(ByVal projetID As Long)
|
|
CurrentDb.Execute "DELETE FROM tbl_Temps WHERE ProjetID = " & projetID
|
|
CurrentDb.Execute "DELETE FROM tbl_Projets WHERE ProjetID = " & projetID
|
|
End Sub
|
|
|
|
'===============================================================================
|
|
' TEMPS
|
|
'===============================================================================
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetTemps
|
|
' Description: Retourne les entrees de temps avec filtres
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetTemps(Optional ByVal projetID As Long = 0, _
|
|
Optional ByVal clientID As Long = 0, _
|
|
Optional ByVal dateDebut As Date = 0, _
|
|
Optional ByVal dateFin As Date = 0) As DAO.Recordset
|
|
Dim sql As String
|
|
sql = "SELECT t.*, p.Nom AS ProjetNom, c.Nom AS ClientNom, " & _
|
|
"t.Duree * p.TauxHoraire AS Montant " & _
|
|
"FROM (tbl_Temps t " & _
|
|
"INNER JOIN tbl_Projets p ON t.ProjetID = p.ProjetID) " & _
|
|
"INNER JOIN tbl_Clients c ON p.ClientID = c.ClientID WHERE 1=1"
|
|
|
|
If projetID > 0 Then
|
|
sql = sql & " AND t.ProjetID = " & projetID
|
|
End If
|
|
|
|
If clientID > 0 Then
|
|
sql = sql & " AND p.ClientID = " & clientID
|
|
End If
|
|
|
|
If dateDebut > 0 Then
|
|
sql = sql & " AND t.Date >= #" & Format(dateDebut, "yyyy-mm-dd") & "#"
|
|
End If
|
|
|
|
If dateFin > 0 Then
|
|
sql = sql & " AND t.Date <= #" & Format(dateFin, "yyyy-mm-dd") & "#"
|
|
End If
|
|
|
|
sql = sql & " ORDER BY t.Date DESC"
|
|
|
|
Set GetTemps = CurrentDb.OpenRecordset(sql, dbOpenDynaset)
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: SaveTemps
|
|
' Description: Sauvegarde une entree de temps
|
|
'-------------------------------------------------------------------------------
|
|
Public Function SaveTemps(ByVal projetID As Long, _
|
|
ByVal dateEntree As Date, _
|
|
ByVal duree As Double, _
|
|
Optional ByVal description As String = "", _
|
|
Optional ByVal tempsID As Long = 0) As Long
|
|
Dim sql As String
|
|
|
|
If tempsID = 0 Then
|
|
sql = "INSERT INTO tbl_Temps (ProjetID, Date, Duree, Description, DateCreation) " & _
|
|
"VALUES (" & projetID & ", #" & Format(dateEntree, "yyyy-mm-dd") & "#, " & _
|
|
duree & ", '" & EscapeSQL(description) & "', Now())"
|
|
CurrentDb.Execute sql, dbFailOnError
|
|
SaveTemps = DMax("TempsID", "tbl_Temps")
|
|
Else
|
|
sql = "UPDATE tbl_Temps SET " & _
|
|
"ProjetID = " & projetID & ", " & _
|
|
"Date = #" & Format(dateEntree, "yyyy-mm-dd") & "#, " & _
|
|
"Duree = " & duree & ", " & _
|
|
"Description = '" & EscapeSQL(description) & "' " & _
|
|
"WHERE TempsID = " & tempsID
|
|
CurrentDb.Execute sql, dbFailOnError
|
|
SaveTemps = tempsID
|
|
End If
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: DeleteTemps
|
|
' Description: Supprime une entree de temps
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub DeleteTemps(ByVal tempsID As Long)
|
|
CurrentDb.Execute "DELETE FROM tbl_Temps WHERE TempsID = " & tempsID
|
|
End Sub
|
|
|
|
'===============================================================================
|
|
' HELPERS
|
|
'===============================================================================
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: EscapeSQL
|
|
' Description: Echappe les apostrophes pour SQL
|
|
'-------------------------------------------------------------------------------
|
|
Private Function EscapeSQL(ByVal text As String) As String
|
|
EscapeSQL = Replace(text, "'", "''")
|
|
End Function
|
|
```
|
|
|
|
---
|
|
|
|
## mod_Calculs
|
|
|
|
Fonctions de calcul et agregation.
|
|
|
|
```vba
|
|
'===============================================================================
|
|
' Module: mod_Calculs
|
|
' Description: Fonctions de calcul et agregation
|
|
' Auteur: Alexis Trouve
|
|
' Date: 2025-12-30
|
|
'===============================================================================
|
|
Option Compare Database
|
|
Option Explicit
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetTotalHeuresProjet
|
|
' Description: Total des heures pour un projet
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetTotalHeuresProjet(ByVal projetID As Long) As Double
|
|
GetTotalHeuresProjet = Nz(DSum("Duree", "tbl_Temps", "ProjetID = " & projetID), 0)
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetTotalHeuresClient
|
|
' Description: Total des heures pour un client
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetTotalHeuresClient(ByVal clientID As Long) As Double
|
|
Dim sql As String
|
|
sql = "SELECT SUM(t.Duree) AS Total FROM tbl_Temps t " & _
|
|
"INNER JOIN tbl_Projets p ON t.ProjetID = p.ProjetID " & _
|
|
"WHERE p.ClientID = " & clientID
|
|
|
|
Dim rs As DAO.Recordset
|
|
Set rs = CurrentDb.OpenRecordset(sql)
|
|
GetTotalHeuresClient = Nz(rs!Total, 0)
|
|
rs.Close
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetTotalHeuresPeriode
|
|
' Description: Total des heures sur une periode
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetTotalHeuresPeriode(ByVal dateDebut As Date, _
|
|
ByVal dateFin As Date, _
|
|
Optional ByVal clientID As Long = 0) As Double
|
|
Dim sql As String
|
|
sql = "SELECT SUM(t.Duree) AS Total FROM tbl_Temps t"
|
|
|
|
If clientID > 0 Then
|
|
sql = sql & " INNER JOIN tbl_Projets p ON t.ProjetID = p.ProjetID" & _
|
|
" WHERE p.ClientID = " & clientID & " AND"
|
|
Else
|
|
sql = sql & " WHERE"
|
|
End If
|
|
|
|
sql = sql & " t.Date BETWEEN #" & Format(dateDebut, "yyyy-mm-dd") & "#" & _
|
|
" AND #" & Format(dateFin, "yyyy-mm-dd") & "#"
|
|
|
|
Dim rs As DAO.Recordset
|
|
Set rs = CurrentDb.OpenRecordset(sql)
|
|
GetTotalHeuresPeriode = Nz(rs!Total, 0)
|
|
rs.Close
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetMontantProjet
|
|
' Description: Montant total pour un projet
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetMontantProjet(ByVal projetID As Long) As Currency
|
|
Dim heures As Double
|
|
Dim taux As Currency
|
|
|
|
heures = GetTotalHeuresProjet(projetID)
|
|
taux = Nz(DLookup("TauxHoraire", "tbl_Projets", "ProjetID = " & projetID), 0)
|
|
|
|
GetMontantProjet = heures * taux
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetMontantClient
|
|
' Description: Montant total pour un client
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetMontantClient(ByVal clientID As Long) As Currency
|
|
Dim sql As String
|
|
sql = "SELECT SUM(t.Duree * p.TauxHoraire) AS Total FROM tbl_Temps t " & _
|
|
"INNER JOIN tbl_Projets p ON t.ProjetID = p.ProjetID " & _
|
|
"WHERE p.ClientID = " & clientID
|
|
|
|
Dim rs As DAO.Recordset
|
|
Set rs = CurrentDb.OpenRecordset(sql)
|
|
GetMontantClient = Nz(rs!Total, 0)
|
|
rs.Close
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetHeuresMoisCourant
|
|
' Description: Total heures du mois en cours
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetHeuresMoisCourant() As Double
|
|
Dim dateDebut As Date
|
|
Dim dateFin As Date
|
|
|
|
dateDebut = DateSerial(Year(Date), Month(Date), 1)
|
|
dateFin = DateSerial(Year(Date), Month(Date) + 1, 0)
|
|
|
|
GetHeuresMoisCourant = GetTotalHeuresPeriode(dateDebut, dateFin)
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetHeuresSemaineCourante
|
|
' Description: Total heures de la semaine en cours
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetHeuresSemaineCourante() As Double
|
|
Dim dateDebut As Date
|
|
Dim dateFin As Date
|
|
|
|
dateDebut = Date - Weekday(Date, vbMonday) + 1
|
|
dateFin = dateDebut + 6
|
|
|
|
GetHeuresSemaineCourante = GetTotalHeuresPeriode(dateDebut, dateFin)
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetNbClients
|
|
' Description: Nombre total de clients
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetNbClients() As Long
|
|
GetNbClients = DCount("*", "tbl_Clients")
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetNbProjetsActifs
|
|
' Description: Nombre de projets actifs
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetNbProjetsActifs() As Long
|
|
GetNbProjetsActifs = DCount("*", "tbl_Projets", "Actif = True")
|
|
End Function
|
|
```
|
|
|
|
---
|
|
|
|
## mod_Export
|
|
|
|
Fonctions d'export PDF et Excel.
|
|
|
|
```vba
|
|
'===============================================================================
|
|
' Module: mod_Export
|
|
' Description: Fonctions d'export PDF et Excel
|
|
' Auteur: Alexis Trouve
|
|
' Date: 2025-12-30
|
|
'===============================================================================
|
|
Option Compare Database
|
|
Option Explicit
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: ExportReportPDF
|
|
' Description: Exporte un rapport en PDF
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub ExportReportPDF(ByVal reportName As String, _
|
|
Optional ByVal fileName As String = "")
|
|
Dim filePath As String
|
|
|
|
mod_Config.EnsureFoldersExist
|
|
|
|
If fileName = "" Then
|
|
fileName = reportName & "_" & Format(Now, "yyyymmdd_hhnnss") & ".pdf"
|
|
End If
|
|
|
|
filePath = EXPORT_PATH & fileName
|
|
|
|
DoCmd.OutputTo acOutputReport, reportName, acFormatPDF, filePath
|
|
|
|
MsgBox "Rapport exporte vers:" & vbCrLf & filePath, vbInformation
|
|
|
|
' Ouvrir le fichier
|
|
Shell "explorer """ & filePath & """", vbNormalFocus
|
|
End Sub
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: ExportQueryExcel
|
|
' Description: Exporte une requete vers Excel
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub ExportQueryExcel(ByVal queryName As String, _
|
|
Optional ByVal fileName As String = "")
|
|
Dim filePath As String
|
|
|
|
mod_Config.EnsureFoldersExist
|
|
|
|
If fileName = "" Then
|
|
fileName = queryName & "_" & Format(Now, "yyyymmdd_hhnnss") & ".xlsx"
|
|
End If
|
|
|
|
filePath = EXPORT_PATH & fileName
|
|
|
|
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
|
|
queryName, filePath, True
|
|
|
|
MsgBox "Donnees exportees vers:" & vbCrLf & filePath, vbInformation
|
|
|
|
' Ouvrir le fichier
|
|
Shell "explorer """ & filePath & """", vbNormalFocus
|
|
End Sub
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: ExportTempsPeriodeExcel
|
|
' Description: Exporte les temps d'une periode vers Excel
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub ExportTempsPeriodeExcel(ByVal dateDebut As Date, _
|
|
ByVal dateFin As Date, _
|
|
Optional ByVal clientID As Long = 0)
|
|
Dim sql As String
|
|
Dim qdf As DAO.QueryDef
|
|
Dim fileName As String
|
|
|
|
' Creer requete temporaire
|
|
sql = "SELECT t.Date, c.Nom AS Client, p.Nom AS Projet, " & _
|
|
"t.Duree, t.Description, t.Duree * p.TauxHoraire AS Montant " & _
|
|
"FROM (tbl_Temps t " & _
|
|
"INNER JOIN tbl_Projets p ON t.ProjetID = p.ProjetID) " & _
|
|
"INNER JOIN tbl_Clients c ON p.ClientID = c.ClientID " & _
|
|
"WHERE t.Date BETWEEN #" & Format(dateDebut, "yyyy-mm-dd") & "# " & _
|
|
"AND #" & Format(dateFin, "yyyy-mm-dd") & "#"
|
|
|
|
If clientID > 0 Then
|
|
sql = sql & " AND p.ClientID = " & clientID
|
|
End If
|
|
|
|
sql = sql & " ORDER BY t.Date"
|
|
|
|
' Supprimer si existe
|
|
On Error Resume Next
|
|
CurrentDb.QueryDefs.Delete "qry_TempExport"
|
|
On Error GoTo 0
|
|
|
|
Set qdf = CurrentDb.CreateQueryDef("qry_TempExport", sql)
|
|
|
|
' Exporter
|
|
fileName = "Temps_" & Format(dateDebut, "yyyymmdd") & "_" & _
|
|
Format(dateFin, "yyyymmdd") & ".xlsx"
|
|
|
|
ExportQueryExcel "qry_TempExport", fileName
|
|
|
|
' Nettoyer
|
|
CurrentDb.QueryDefs.Delete "qry_TempExport"
|
|
End Sub
|
|
```
|
|
|
|
---
|
|
|
|
## mod_Utils
|
|
|
|
Fonctions utilitaires diverses.
|
|
|
|
```vba
|
|
'===============================================================================
|
|
' Module: mod_Utils
|
|
' Description: Fonctions utilitaires diverses
|
|
' Auteur: Alexis Trouve
|
|
' Date: 2025-12-30
|
|
'===============================================================================
|
|
Option Compare Database
|
|
Option Explicit
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: FormatDuree
|
|
' Description: Formate une duree en heures
|
|
'-------------------------------------------------------------------------------
|
|
Public Function FormatDuree(ByVal heures As Double) As String
|
|
FormatDuree = Format(heures, "0.00") & " h"
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: FormatMontant
|
|
' Description: Formate un montant en euros
|
|
'-------------------------------------------------------------------------------
|
|
Public Function FormatMontant(ByVal montant As Currency) As String
|
|
FormatMontant = Format(montant, "#,##0.00") & " €"
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: FormatDateFR
|
|
' Description: Formate une date en francais
|
|
'-------------------------------------------------------------------------------
|
|
Public Function FormatDateFR(ByVal d As Date) As String
|
|
FormatDateFR = Format(d, "dd/mm/yyyy")
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: IsValidEmail
|
|
' Description: Valide un format email basique
|
|
'-------------------------------------------------------------------------------
|
|
Public Function IsValidEmail(ByVal email As String) As Boolean
|
|
If Len(email) = 0 Then
|
|
IsValidEmail = True ' Email optionnel
|
|
Exit Function
|
|
End If
|
|
|
|
IsValidEmail = (InStr(email, "@") > 1) And (InStr(email, ".") > InStr(email, "@") + 1)
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetFirstDayOfMonth
|
|
' Description: Premier jour du mois
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetFirstDayOfMonth(Optional ByVal d As Date = 0) As Date
|
|
If d = 0 Then d = Date
|
|
GetFirstDayOfMonth = DateSerial(Year(d), Month(d), 1)
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetLastDayOfMonth
|
|
' Description: Dernier jour du mois
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetLastDayOfMonth(Optional ByVal d As Date = 0) As Date
|
|
If d = 0 Then d = Date
|
|
GetLastDayOfMonth = DateSerial(Year(d), Month(d) + 1, 0)
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: GetFirstDayOfWeek
|
|
' Description: Premier jour de la semaine (lundi)
|
|
'-------------------------------------------------------------------------------
|
|
Public Function GetFirstDayOfWeek(Optional ByVal d As Date = 0) As Date
|
|
If d = 0 Then d = Date
|
|
GetFirstDayOfWeek = d - Weekday(d, vbMonday) + 1
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: ShowError
|
|
' Description: Affiche un message d'erreur standardise
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub ShowError(ByVal message As String, Optional ByVal details As String = "")
|
|
Dim msg As String
|
|
msg = message
|
|
If Len(details) > 0 Then
|
|
msg = msg & vbCrLf & vbCrLf & "Details: " & details
|
|
End If
|
|
MsgBox msg, vbExclamation, APP_NAME
|
|
End Sub
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: ShowInfo
|
|
' Description: Affiche un message d'information
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub ShowInfo(ByVal message As String)
|
|
MsgBox message, vbInformation, APP_NAME
|
|
End Sub
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Function: Confirm
|
|
' Description: Demande confirmation a l'utilisateur
|
|
'-------------------------------------------------------------------------------
|
|
Public Function Confirm(ByVal message As String) As Boolean
|
|
Confirm = (MsgBox(message, vbQuestion + vbYesNo, APP_NAME) = vbYes)
|
|
End Function
|
|
|
|
'-------------------------------------------------------------------------------
|
|
' Sub: LogAction
|
|
' Description: Log une action (pour debug)
|
|
'-------------------------------------------------------------------------------
|
|
Public Sub LogAction(ByVal action As String)
|
|
Debug.Print Format(Now, "yyyy-mm-dd hh:nn:ss") & " - " & action
|
|
End Sub
|
|
```
|
|
|
|
---
|
|
|
|
## Injection via MCP VBA
|
|
|
|
Pour injecter ces modules dans une base Access :
|
|
|
|
```python
|
|
# Avec VBA MCP Server
|
|
inject_vba("TimeTrackPro.accdb", "mod_Config", code_config)
|
|
inject_vba("TimeTrackPro.accdb", "mod_Navigation", code_navigation)
|
|
inject_vba("TimeTrackPro.accdb", "mod_DataAccess", code_dataaccess)
|
|
inject_vba("TimeTrackPro.accdb", "mod_Calculs", code_calculs)
|
|
inject_vba("TimeTrackPro.accdb", "mod_Export", code_export)
|
|
inject_vba("TimeTrackPro.accdb", "mod_Utils", code_utils)
|
|
```
|
|
|
|
---
|
|
|
|
**Version:** 1.0
|
|
**Date:** 2025-12-30
|