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>
32 KiB
32 KiB
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.
'===============================================================================
' 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.
'===============================================================================
' 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.
'===============================================================================
' 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.
'===============================================================================
' 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.
'===============================================================================
' 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.
'===============================================================================
' 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 :
# 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