Add VBA source files for GitHub readability
- Export 7 VBA modules as .bas files in src/ - Add form button helper functions (GoToNewRecord, DeleteCurrentRecord, SaveAndNew) - Export frm_Accueil form definition as text 🤖 Generated with [Claude Code](https://claude.com/claude-code) Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
This commit is contained in:
parent
b3a3c0f849
commit
066e4b68f4
Binary file not shown.
BIN
src/forms/frm_Accueil.txt
Normal file
BIN
src/forms/frm_Accueil.txt
Normal file
Binary file not shown.
134
src/mod_Calculs.bas
Normal file
134
src/mod_Calculs.bas
Normal file
@ -0,0 +1,134 @@
|
|||||||
|
Attribute VB_Name = "mod_Calculs"
|
||||||
|
Option Compare Database
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
'===============================================================================
|
||||||
|
' Module: mod_Calculs
|
||||||
|
' Description: Fonctions de calcul et agregation
|
||||||
|
' Auteur: Alexis Trouve
|
||||||
|
' Date: 2025-12-30
|
||||||
|
'===============================================================================
|
||||||
|
|
||||||
|
'-------------------------------------------------------------------------------
|
||||||
|
' 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
|
||||||
51
src/mod_Config.bas
Normal file
51
src/mod_Config.bas
Normal file
@ -0,0 +1,51 @@
|
|||||||
|
Attribute VB_Name = "mod_Config"
|
||||||
|
Option Compare Database
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
'===============================================================================
|
||||||
|
' Module: mod_Config
|
||||||
|
' Description: Constantes et parametres globaux de TimeTrack Pro
|
||||||
|
' Auteur: Alexis Trouve
|
||||||
|
' Date: 2025-12-30
|
||||||
|
'===============================================================================
|
||||||
|
|
||||||
|
' 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 EUR"
|
||||||
|
|
||||||
|
' 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
|
||||||
236
src/mod_DataAccess.bas
Normal file
236
src/mod_DataAccess.bas
Normal file
@ -0,0 +1,236 @@
|
|||||||
|
Attribute VB_Name = "mod_DataAccess"
|
||||||
|
Option Compare Database
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
'===============================================================================
|
||||||
|
' Module: mod_DataAccess
|
||||||
|
' Description: Fonctions CRUD pour acces aux donnees
|
||||||
|
' Auteur: Alexis Trouve
|
||||||
|
' Date: 2025-12-30
|
||||||
|
'===============================================================================
|
||||||
|
|
||||||
|
'===============================================================================
|
||||||
|
' 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
|
||||||
102
src/mod_Export.bas
Normal file
102
src/mod_Export.bas
Normal file
@ -0,0 +1,102 @@
|
|||||||
|
Attribute VB_Name = "mod_Export"
|
||||||
|
Option Compare Database
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
'===============================================================================
|
||||||
|
' Module: mod_Export
|
||||||
|
' Description: Fonctions d'export PDF et Excel
|
||||||
|
' Auteur: Alexis Trouve
|
||||||
|
' Date: 2025-12-30
|
||||||
|
'===============================================================================
|
||||||
|
|
||||||
|
'-------------------------------------------------------------------------------
|
||||||
|
' 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
|
||||||
212
src/mod_FormBuilder.bas
Normal file
212
src/mod_FormBuilder.bas
Normal file
@ -0,0 +1,212 @@
|
|||||||
|
Attribute VB_Name = "mod_FormBuilder"
|
||||||
|
Option Compare Database
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
'===============================================================================
|
||||||
|
' Module: mod_FormBuilder
|
||||||
|
' Description: Creation programmatique des formulaires
|
||||||
|
' Auteur: Alexis Trouve
|
||||||
|
' Date: 2025-12-30
|
||||||
|
'===============================================================================
|
||||||
|
|
||||||
|
Private Const acLabel As Integer = 100
|
||||||
|
Private Const acTextBox As Integer = 109
|
||||||
|
Private Const acComboBox As Integer = 111
|
||||||
|
Private Const acCommandButton As Integer = 104
|
||||||
|
Private Const acDetail As Integer = 0
|
||||||
|
Private Const acHeader As Integer = 1
|
||||||
|
|
||||||
|
Public Sub BuildAllForms()
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
BuildFormAccueil
|
||||||
|
BuildFormClients
|
||||||
|
BuildFormProjets
|
||||||
|
BuildFormSaisieTemps
|
||||||
|
BuildFormHistorique
|
||||||
|
MsgBox "Formulaires crees avec succes!", vbInformation
|
||||||
|
Exit Sub
|
||||||
|
ErrHandler:
|
||||||
|
MsgBox "Erreur: " & Err.Description, vbCritical
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Public Sub BuildFormAccueil()
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
Dim frm As Form, ctl As Control
|
||||||
|
On Error Resume Next
|
||||||
|
DoCmd.DeleteObject acForm, "frm_Accueil"
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
Set frm = CreateForm()
|
||||||
|
frm.Caption = "TimeTrack Pro"
|
||||||
|
frm.RecordSelectors = False
|
||||||
|
frm.NavigationButtons = False
|
||||||
|
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 500, 300, 5000, 500)
|
||||||
|
ctl.Caption = "TimeTrack Pro"
|
||||||
|
ctl.FontSize = 20
|
||||||
|
ctl.FontBold = True
|
||||||
|
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 500, 1200, 2200, 500)
|
||||||
|
ctl.Caption = "Clients"
|
||||||
|
ctl.OnClick = "=OpenFormClients()"
|
||||||
|
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 500, 1900, 2200, 500)
|
||||||
|
ctl.Caption = "Projets"
|
||||||
|
ctl.OnClick = "=OpenFormProjets()"
|
||||||
|
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 500, 2600, 2200, 500)
|
||||||
|
ctl.Caption = "Saisie Temps"
|
||||||
|
ctl.OnClick = "=OpenFormSaisieTemps()"
|
||||||
|
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 500, 3300, 2200, 500)
|
||||||
|
ctl.Caption = "Historique"
|
||||||
|
ctl.OnClick = "=OpenFormHistorique()"
|
||||||
|
DoCmd.Close acForm, frm.Name, acSaveYes
|
||||||
|
DoCmd.Rename "frm_Accueil", acForm, frm.Name
|
||||||
|
Exit Sub
|
||||||
|
ErrHandler:
|
||||||
|
MsgBox "Erreur Accueil: " & Err.Description, vbCritical
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Public Sub BuildFormClients()
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
Dim frm As Form, ctl As Control
|
||||||
|
On Error Resume Next
|
||||||
|
DoCmd.DeleteObject acForm, "frm_Clients"
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
Set frm = CreateForm()
|
||||||
|
frm.RecordSource = "tbl_Clients"
|
||||||
|
frm.Caption = "Clients"
|
||||||
|
frm.NavigationButtons = True
|
||||||
|
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 200, 1200, 250)
|
||||||
|
ctl.Caption = "Nom:"
|
||||||
|
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 200, 3500, 250)
|
||||||
|
ctl.ControlSource = "Nom"
|
||||||
|
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 550, 1200, 250)
|
||||||
|
ctl.Caption = "Email:"
|
||||||
|
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 550, 3500, 250)
|
||||||
|
ctl.ControlSource = "Email"
|
||||||
|
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 900, 1200, 250)
|
||||||
|
ctl.Caption = "Tel:"
|
||||||
|
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 900, 2000, 250)
|
||||||
|
ctl.ControlSource = "Telephone"
|
||||||
|
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 200, 1400, 1500, 400)
|
||||||
|
ctl.Caption = "Nouveau"
|
||||||
|
ctl.OnClick = "=GoToNewRecord()"
|
||||||
|
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 1900, 1400, 1500, 400)
|
||||||
|
ctl.Caption = "Retour"
|
||||||
|
ctl.OnClick = "=OpenFormAccueil()"
|
||||||
|
DoCmd.Close acForm, frm.Name, acSaveYes
|
||||||
|
DoCmd.Rename "frm_Clients", acForm, frm.Name
|
||||||
|
Exit Sub
|
||||||
|
ErrHandler:
|
||||||
|
MsgBox "Erreur Clients: " & Err.Description, vbCritical
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Public Sub BuildFormProjets()
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
Dim frm As Form, ctl As Control
|
||||||
|
On Error Resume Next
|
||||||
|
DoCmd.DeleteObject acForm, "frm_Projets"
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
Set frm = CreateForm()
|
||||||
|
frm.RecordSource = "tbl_Projets"
|
||||||
|
frm.Caption = "Projets"
|
||||||
|
frm.NavigationButtons = True
|
||||||
|
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 200, 1200, 250)
|
||||||
|
ctl.Caption = "Client:"
|
||||||
|
Set ctl = CreateControl(frm.Name, acComboBox, acDetail, , , 1500, 200, 3000, 250)
|
||||||
|
ctl.ControlSource = "ClientID"
|
||||||
|
ctl.RowSource = "SELECT ClientID, Nom FROM tbl_Clients"
|
||||||
|
ctl.ColumnCount = 2
|
||||||
|
ctl.ColumnWidths = "0;2500"
|
||||||
|
ctl.BoundColumn = 1
|
||||||
|
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 550, 1200, 250)
|
||||||
|
ctl.Caption = "Nom:"
|
||||||
|
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 550, 3000, 250)
|
||||||
|
ctl.ControlSource = "Nom"
|
||||||
|
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 900, 1200, 250)
|
||||||
|
ctl.Caption = "Taux:"
|
||||||
|
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 900, 1500, 250)
|
||||||
|
ctl.ControlSource = "TauxHoraire"
|
||||||
|
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 200, 1400, 1500, 400)
|
||||||
|
ctl.Caption = "Nouveau"
|
||||||
|
ctl.OnClick = "=GoToNewRecord()"
|
||||||
|
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 1900, 1400, 1500, 400)
|
||||||
|
ctl.Caption = "Retour"
|
||||||
|
ctl.OnClick = "=OpenFormAccueil()"
|
||||||
|
DoCmd.Close acForm, frm.Name, acSaveYes
|
||||||
|
DoCmd.Rename "frm_Projets", acForm, frm.Name
|
||||||
|
Exit Sub
|
||||||
|
ErrHandler:
|
||||||
|
MsgBox "Erreur Projets: " & Err.Description, vbCritical
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Public Sub BuildFormSaisieTemps()
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
Dim frm As Form, ctl As Control
|
||||||
|
On Error Resume Next
|
||||||
|
DoCmd.DeleteObject acForm, "frm_SaisieTemps"
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
Set frm = CreateForm()
|
||||||
|
frm.RecordSource = "tbl_Temps"
|
||||||
|
frm.Caption = "Saisie Temps"
|
||||||
|
frm.NavigationButtons = True
|
||||||
|
frm.DataEntry = True
|
||||||
|
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 200, 1200, 250)
|
||||||
|
ctl.Caption = "Projet:"
|
||||||
|
Set ctl = CreateControl(frm.Name, acComboBox, acDetail, , , 1500, 200, 4000, 250)
|
||||||
|
ctl.ControlSource = "ProjetID"
|
||||||
|
ctl.RowSource = "SELECT ProjetID, Nom FROM tbl_Projets WHERE Actif=True"
|
||||||
|
ctl.ColumnCount = 2
|
||||||
|
ctl.ColumnWidths = "0;3500"
|
||||||
|
ctl.BoundColumn = 1
|
||||||
|
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 550, 1200, 250)
|
||||||
|
ctl.Caption = "Date:"
|
||||||
|
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 550, 1800, 250)
|
||||||
|
ctl.ControlSource = "Date"
|
||||||
|
ctl.DefaultValue = "=Date()"
|
||||||
|
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 900, 1200, 250)
|
||||||
|
ctl.Caption = "Duree:"
|
||||||
|
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 900, 1000, 250)
|
||||||
|
ctl.ControlSource = "Duree"
|
||||||
|
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 1250, 1200, 250)
|
||||||
|
ctl.Caption = "Notes:"
|
||||||
|
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 1250, 4000, 600)
|
||||||
|
ctl.ControlSource = "Description"
|
||||||
|
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 200, 2000, 1500, 400)
|
||||||
|
ctl.Caption = "Enregistrer"
|
||||||
|
ctl.OnClick = "=SaveAndNew()"
|
||||||
|
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 1900, 2000, 1500, 400)
|
||||||
|
ctl.Caption = "Retour"
|
||||||
|
ctl.OnClick = "=OpenFormAccueil()"
|
||||||
|
DoCmd.Close acForm, frm.Name, acSaveYes
|
||||||
|
DoCmd.Rename "frm_SaisieTemps", acForm, frm.Name
|
||||||
|
Exit Sub
|
||||||
|
ErrHandler:
|
||||||
|
MsgBox "Erreur Saisie: " & Err.Description, vbCritical
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Public Sub BuildFormHistorique()
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
Dim frm As Form, ctl As Control
|
||||||
|
On Error Resume Next
|
||||||
|
DoCmd.DeleteObject acForm, "frm_Historique"
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
Set frm = CreateForm()
|
||||||
|
frm.RecordSource = "SELECT t.*, p.Nom AS Projet, c.Nom AS Client FROM (tbl_Temps t INNER JOIN tbl_Projets p ON t.ProjetID=p.ProjetID) INNER JOIN tbl_Clients c ON p.ClientID=c.ClientID"
|
||||||
|
frm.Caption = "Historique"
|
||||||
|
frm.DefaultView = 2
|
||||||
|
frm.AllowEdits = False
|
||||||
|
frm.AllowAdditions = False
|
||||||
|
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 100, 100, 1500, 250)
|
||||||
|
ctl.ControlSource = "Client"
|
||||||
|
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1700, 100, 1500, 250)
|
||||||
|
ctl.ControlSource = "Projet"
|
||||||
|
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 3300, 100, 1200, 250)
|
||||||
|
ctl.ControlSource = "Date"
|
||||||
|
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 4600, 100, 800, 250)
|
||||||
|
ctl.ControlSource = "Duree"
|
||||||
|
Set ctl = CreateControl(frm.Name, acCommandButton, acHeader, , , 200, 200, 1500, 400)
|
||||||
|
ctl.Caption = "Retour"
|
||||||
|
ctl.OnClick = "=OpenFormAccueil()"
|
||||||
|
DoCmd.Close acForm, frm.Name, acSaveYes
|
||||||
|
DoCmd.Rename "frm_Historique", acForm, frm.Name
|
||||||
|
Exit Sub
|
||||||
|
ErrHandler:
|
||||||
|
MsgBox "Erreur Historique: " & Err.Description, vbCritical
|
||||||
|
End Sub
|
||||||
104
src/mod_Navigation.bas
Normal file
104
src/mod_Navigation.bas
Normal file
@ -0,0 +1,104 @@
|
|||||||
|
Attribute VB_Name = "mod_Navigation"
|
||||||
|
Option Compare Database
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
'===============================================================================
|
||||||
|
' Module: mod_Navigation
|
||||||
|
' Description: Fonctions de navigation entre formulaires
|
||||||
|
' Auteur: Alexis Trouve
|
||||||
|
' Date: 2025-12-30
|
||||||
|
'===============================================================================
|
||||||
|
|
||||||
|
Public Sub OpenFormAccueil()
|
||||||
|
DoCmd.OpenForm "frm_Accueil"
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
Public Sub OpenFormHistorique()
|
||||||
|
DoCmd.OpenForm "frm_Historique"
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Public Sub CloseCurrentForm()
|
||||||
|
DoCmd.Close acForm, Screen.ActiveForm.Name
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Public Sub CloseAllForms()
|
||||||
|
Dim frm As Form
|
||||||
|
For Each frm In Forms
|
||||||
|
DoCmd.Close acForm, frm.Name
|
||||||
|
Next frm
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
Public Sub RefreshCurrentForm()
|
||||||
|
Screen.ActiveForm.Requery
|
||||||
|
End Sub
|
||||||
|
|
||||||
|
'-------------------------------------------------------------------------------
|
||||||
|
' Function: GoToNewRecord
|
||||||
|
' Description: Navigue vers un nouvel enregistrement (pour boutons)
|
||||||
|
'-------------------------------------------------------------------------------
|
||||||
|
Public Function GoToNewRecord() As Boolean
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
DoCmd.GoToRecord , , acNewRec
|
||||||
|
GoToNewRecord = True
|
||||||
|
Exit Function
|
||||||
|
ErrHandler:
|
||||||
|
MsgBox "Erreur: " & Err.Description, vbExclamation, "Nouveau"
|
||||||
|
GoToNewRecord = False
|
||||||
|
End Function
|
||||||
|
|
||||||
|
'-------------------------------------------------------------------------------
|
||||||
|
' Function: DeleteCurrentRecord
|
||||||
|
' Description: Supprime l'enregistrement courant avec confirmation
|
||||||
|
'-------------------------------------------------------------------------------
|
||||||
|
Public Function DeleteCurrentRecord() As Boolean
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
If MsgBox("Voulez-vous supprimer?", vbYesNo + vbQuestion, "Confirmer") = vbYes Then
|
||||||
|
DoCmd.RunCommand acCmdDeleteRecord
|
||||||
|
DeleteCurrentRecord = True
|
||||||
|
Else
|
||||||
|
DeleteCurrentRecord = False
|
||||||
|
End If
|
||||||
|
Exit Function
|
||||||
|
ErrHandler:
|
||||||
|
MsgBox "Erreur: " & Err.Description, vbExclamation, "Supprimer"
|
||||||
|
DeleteCurrentRecord = False
|
||||||
|
End Function
|
||||||
|
|
||||||
|
'-------------------------------------------------------------------------------
|
||||||
|
' Function: SaveAndNew
|
||||||
|
' Description: Sauvegarde l'enregistrement et va vers nouveau
|
||||||
|
'-------------------------------------------------------------------------------
|
||||||
|
Public Function SaveAndNew() As Boolean
|
||||||
|
On Error GoTo ErrHandler
|
||||||
|
DoCmd.RunCommand acCmdSaveRecord
|
||||||
|
DoCmd.GoToRecord , , acNewRec
|
||||||
|
SaveAndNew = True
|
||||||
|
Exit Function
|
||||||
|
ErrHandler:
|
||||||
|
MsgBox "Erreur: " & Err.Description, vbExclamation, "Enregistrer"
|
||||||
|
SaveAndNew = False
|
||||||
|
End Function
|
||||||
111
src/mod_Utils.bas
Normal file
111
src/mod_Utils.bas
Normal file
@ -0,0 +1,111 @@
|
|||||||
|
Attribute VB_Name = "mod_Utils"
|
||||||
|
Option Compare Database
|
||||||
|
Option Explicit
|
||||||
|
|
||||||
|
'===============================================================================
|
||||||
|
' Module: mod_Utils
|
||||||
|
' Description: Fonctions utilitaires diverses
|
||||||
|
' Auteur: Alexis Trouve
|
||||||
|
' Date: 2025-12-30
|
||||||
|
'===============================================================================
|
||||||
|
|
||||||
|
'-------------------------------------------------------------------------------
|
||||||
|
' 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") & " EUR"
|
||||||
|
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
|
||||||
Loading…
Reference in New Issue
Block a user