diff --git a/db/TimeTrackPro.accdb b/db/TimeTrackPro.accdb index d58ebae..8872032 100644 Binary files a/db/TimeTrackPro.accdb and b/db/TimeTrackPro.accdb differ diff --git a/src/forms/frm_Accueil.txt b/src/forms/frm_Accueil.txt new file mode 100644 index 0000000..423a1b5 Binary files /dev/null and b/src/forms/frm_Accueil.txt differ diff --git a/src/mod_Calculs.bas b/src/mod_Calculs.bas new file mode 100644 index 0000000..72dc2ba --- /dev/null +++ b/src/mod_Calculs.bas @@ -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 diff --git a/src/mod_Config.bas b/src/mod_Config.bas new file mode 100644 index 0000000..bf95f21 --- /dev/null +++ b/src/mod_Config.bas @@ -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 diff --git a/src/mod_DataAccess.bas b/src/mod_DataAccess.bas new file mode 100644 index 0000000..2e690e1 --- /dev/null +++ b/src/mod_DataAccess.bas @@ -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 diff --git a/src/mod_Export.bas b/src/mod_Export.bas new file mode 100644 index 0000000..736779b --- /dev/null +++ b/src/mod_Export.bas @@ -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 diff --git a/src/mod_FormBuilder.bas b/src/mod_FormBuilder.bas new file mode 100644 index 0000000..fcacc48 --- /dev/null +++ b/src/mod_FormBuilder.bas @@ -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 diff --git a/src/mod_Navigation.bas b/src/mod_Navigation.bas new file mode 100644 index 0000000..0fde99b --- /dev/null +++ b/src/mod_Navigation.bas @@ -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 diff --git a/src/mod_Utils.bas b/src/mod_Utils.bas new file mode 100644 index 0000000..b53c2d4 --- /dev/null +++ b/src/mod_Utils.bas @@ -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