Fix forms and navigation - all buttons working

- Convert navigation Subs to Functions for button OnClick
- Fix form builder to properly rename forms (sName variable)
- Fix frm_Historique with continuous view and reduced row height
- Update src/ with latest VBA code

🤖 Generated with [Claude Code](https://claude.com/claude-code)

Co-Authored-By: Claude Opus 4.5 <noreply@anthropic.com>
This commit is contained in:
StillHammer 2026-01-03 13:01:57 +07:00
parent 8634badd51
commit 978061211d
3 changed files with 96 additions and 144 deletions

Binary file not shown.

View File

@ -2,211 +2,194 @@ Attribute VB_Name = "mod_FormBuilder"
Option Compare Database Option Compare Database
Option Explicit 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 acLabel As Integer = 100
Private Const acTextBox As Integer = 109 Private Const acTextBox As Integer = 109
Private Const acComboBox As Integer = 111 Private Const acComboBox As Integer = 111
Private Const acCommandButton As Integer = 104 Private Const acCommandButton As Integer = 104
Private Const acDetail As Integer = 0 Private Const acDetail As Integer = 0
Private Const acHeader As Integer = 1
Public Sub BuildAllForms() Public Sub BuildAllForms()
On Error Resume Next
DoCmd.Close acForm, "frm_Accueil"
DoCmd.Close acForm, "frm_Clients"
DoCmd.Close acForm, "frm_Projets"
DoCmd.Close acForm, "frm_SaisieTemps"
DoCmd.Close acForm, "frm_Historique"
On Error GoTo ErrHandler On Error GoTo ErrHandler
BuildFormAccueil BuildFormAccueil
BuildFormClients BuildFormClients
BuildFormProjets BuildFormProjets
BuildFormSaisieTemps BuildFormSaisieTemps
BuildFormHistorique BuildFormHistorique
MsgBox "Formulaires crees avec succes!", vbInformation MsgBox "Formulaires crees!", vbInformation
Exit Sub Exit Sub
ErrHandler: ErrHandler:
MsgBox "Erreur: " & Err.Description, vbCritical MsgBox "Erreur: " & Err.Description, vbCritical
End Sub End Sub
Public Sub BuildFormAccueil() Public Sub BuildFormAccueil()
On Error GoTo ErrHandler Dim frm As Form, ctl As Control, sName As String
Dim frm As Form, ctl As Control
On Error Resume Next On Error Resume Next
DoCmd.DeleteObject acForm, "frm_Accueil" DoCmd.DeleteObject acForm, "frm_Accueil"
On Error GoTo ErrHandler On Error GoTo 0
Set frm = CreateForm() Set frm = CreateForm()
sName = frm.Name
frm.Caption = "TimeTrack Pro" frm.Caption = "TimeTrack Pro"
frm.RecordSelectors = False frm.RecordSelectors = False
frm.NavigationButtons = False frm.NavigationButtons = False
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 500, 300, 5000, 500) Set ctl = CreateControl(sName, acLabel, acDetail, , , 500, 300, 5000, 500)
ctl.Caption = "TimeTrack Pro" ctl.Caption = "TimeTrack Pro"
ctl.FontSize = 20 ctl.FontSize = 20
ctl.FontBold = True ctl.FontBold = True
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 500, 1200, 2200, 500) Set ctl = CreateControl(sName, acCommandButton, acDetail, , , 500, 1200, 2200, 500)
ctl.Caption = "Clients" ctl.Caption = "Clients"
ctl.OnClick = "=OpenFormClients()" ctl.OnClick = "=OpenFormClients()"
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 500, 1900, 2200, 500) Set ctl = CreateControl(sName, acCommandButton, acDetail, , , 500, 1900, 2200, 500)
ctl.Caption = "Projets" ctl.Caption = "Projets"
ctl.OnClick = "=OpenFormProjets()" ctl.OnClick = "=OpenFormProjets()"
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 500, 2600, 2200, 500) Set ctl = CreateControl(sName, acCommandButton, acDetail, , , 500, 2600, 2200, 500)
ctl.Caption = "Saisie Temps" ctl.Caption = "Saisie Temps"
ctl.OnClick = "=OpenFormSaisieTemps()" ctl.OnClick = "=OpenFormSaisieTemps()"
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 500, 3300, 2200, 500) Set ctl = CreateControl(sName, acCommandButton, acDetail, , , 500, 3300, 2200, 500)
ctl.Caption = "Historique" ctl.Caption = "Historique"
ctl.OnClick = "=OpenFormHistorique()" ctl.OnClick = "=OpenFormHistorique()"
DoCmd.Close acForm, frm.Name, acSaveYes DoCmd.Close acForm, sName, acSaveYes
DoCmd.Rename "frm_Accueil", acForm, frm.Name DoCmd.Rename "frm_Accueil", acForm, sName
Exit Sub
ErrHandler:
MsgBox "Erreur Accueil: " & Err.Description, vbCritical
End Sub End Sub
Public Sub BuildFormClients() Public Sub BuildFormClients()
On Error GoTo ErrHandler Dim frm As Form, ctl As Control, sName As String
Dim frm As Form, ctl As Control
On Error Resume Next On Error Resume Next
DoCmd.DeleteObject acForm, "frm_Clients" DoCmd.DeleteObject acForm, "frm_Clients"
On Error GoTo ErrHandler On Error GoTo 0
Set frm = CreateForm() Set frm = CreateForm()
sName = frm.Name
frm.RecordSource = "tbl_Clients" frm.RecordSource = "tbl_Clients"
frm.Caption = "Clients" frm.Caption = "Clients"
frm.NavigationButtons = True frm.NavigationButtons = True
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 200, 1200, 250) Set ctl = CreateControl(sName, acLabel, acDetail, , , 200, 200, 1200, 250)
ctl.Caption = "Nom:" ctl.Caption = "Nom:"
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 200, 3500, 250) Set ctl = CreateControl(sName, acTextBox, acDetail, , , 1500, 200, 3500, 250)
ctl.ControlSource = "Nom" ctl.ControlSource = "Nom"
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 550, 1200, 250) Set ctl = CreateControl(sName, acLabel, acDetail, , , 200, 550, 1200, 250)
ctl.Caption = "Email:" ctl.Caption = "Email:"
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 550, 3500, 250) Set ctl = CreateControl(sName, acTextBox, acDetail, , , 1500, 550, 3500, 250)
ctl.ControlSource = "Email" ctl.ControlSource = "Email"
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 900, 1200, 250) Set ctl = CreateControl(sName, acLabel, acDetail, , , 200, 900, 1200, 250)
ctl.Caption = "Tel:" ctl.Caption = "Tel:"
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 900, 2000, 250) Set ctl = CreateControl(sName, acTextBox, acDetail, , , 1500, 900, 2000, 250)
ctl.ControlSource = "Telephone" ctl.ControlSource = "Telephone"
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 200, 1400, 1500, 400) Set ctl = CreateControl(sName, acCommandButton, acDetail, , , 200, 1400, 1500, 400)
ctl.Caption = "Nouveau" ctl.Caption = "Nouveau"
ctl.OnClick = "=GoToNewRecord()" ctl.OnClick = "=GoToNewRecord()"
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 1900, 1400, 1500, 400) Set ctl = CreateControl(sName, acCommandButton, acDetail, , , 1900, 1400, 1500, 400)
ctl.Caption = "Retour" ctl.Caption = "Retour"
ctl.OnClick = "=OpenFormAccueil()" ctl.OnClick = "=OpenFormAccueil()"
DoCmd.Close acForm, frm.Name, acSaveYes DoCmd.Close acForm, sName, acSaveYes
DoCmd.Rename "frm_Clients", acForm, frm.Name DoCmd.Rename "frm_Clients", acForm, sName
Exit Sub
ErrHandler:
MsgBox "Erreur Clients: " & Err.Description, vbCritical
End Sub End Sub
Public Sub BuildFormProjets() Public Sub BuildFormProjets()
On Error GoTo ErrHandler Dim frm As Form, ctl As Control, sName As String
Dim frm As Form, ctl As Control
On Error Resume Next On Error Resume Next
DoCmd.DeleteObject acForm, "frm_Projets" DoCmd.DeleteObject acForm, "frm_Projets"
On Error GoTo ErrHandler On Error GoTo 0
Set frm = CreateForm() Set frm = CreateForm()
sName = frm.Name
frm.RecordSource = "tbl_Projets" frm.RecordSource = "tbl_Projets"
frm.Caption = "Projets" frm.Caption = "Projets"
frm.NavigationButtons = True frm.NavigationButtons = True
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 200, 1200, 250) Set ctl = CreateControl(sName, acLabel, acDetail, , , 200, 200, 1200, 250)
ctl.Caption = "Client:" ctl.Caption = "Client:"
Set ctl = CreateControl(frm.Name, acComboBox, acDetail, , , 1500, 200, 3000, 250) Set ctl = CreateControl(sName, acComboBox, acDetail, , , 1500, 200, 3000, 250)
ctl.ControlSource = "ClientID" ctl.ControlSource = "ClientID"
ctl.RowSource = "SELECT ClientID, Nom FROM tbl_Clients" ctl.RowSource = "SELECT ClientID, Nom FROM tbl_Clients"
ctl.ColumnCount = 2 ctl.ColumnCount = 2
ctl.ColumnWidths = "0;2500" ctl.ColumnWidths = "0;2500"
ctl.BoundColumn = 1 ctl.BoundColumn = 1
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 550, 1200, 250) Set ctl = CreateControl(sName, acLabel, acDetail, , , 200, 550, 1200, 250)
ctl.Caption = "Nom:" ctl.Caption = "Nom:"
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 550, 3000, 250) Set ctl = CreateControl(sName, acTextBox, acDetail, , , 1500, 550, 3000, 250)
ctl.ControlSource = "Nom" ctl.ControlSource = "Nom"
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 900, 1200, 250) Set ctl = CreateControl(sName, acLabel, acDetail, , , 200, 900, 1200, 250)
ctl.Caption = "Taux:" ctl.Caption = "Taux:"
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 900, 1500, 250) Set ctl = CreateControl(sName, acTextBox, acDetail, , , 1500, 900, 1500, 250)
ctl.ControlSource = "TauxHoraire" ctl.ControlSource = "TauxHoraire"
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 200, 1400, 1500, 400) Set ctl = CreateControl(sName, acCommandButton, acDetail, , , 200, 1400, 1500, 400)
ctl.Caption = "Nouveau" ctl.Caption = "Nouveau"
ctl.OnClick = "=GoToNewRecord()" ctl.OnClick = "=GoToNewRecord()"
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 1900, 1400, 1500, 400) Set ctl = CreateControl(sName, acCommandButton, acDetail, , , 1900, 1400, 1500, 400)
ctl.Caption = "Retour" ctl.Caption = "Retour"
ctl.OnClick = "=OpenFormAccueil()" ctl.OnClick = "=OpenFormAccueil()"
DoCmd.Close acForm, frm.Name, acSaveYes DoCmd.Close acForm, sName, acSaveYes
DoCmd.Rename "frm_Projets", acForm, frm.Name DoCmd.Rename "frm_Projets", acForm, sName
Exit Sub
ErrHandler:
MsgBox "Erreur Projets: " & Err.Description, vbCritical
End Sub End Sub
Public Sub BuildFormSaisieTemps() Public Sub BuildFormSaisieTemps()
On Error GoTo ErrHandler Dim frm As Form, ctl As Control, sName As String
Dim frm As Form, ctl As Control
On Error Resume Next On Error Resume Next
DoCmd.DeleteObject acForm, "frm_SaisieTemps" DoCmd.DeleteObject acForm, "frm_SaisieTemps"
On Error GoTo ErrHandler On Error GoTo 0
Set frm = CreateForm() Set frm = CreateForm()
sName = frm.Name
frm.RecordSource = "tbl_Temps" frm.RecordSource = "tbl_Temps"
frm.Caption = "Saisie Temps" frm.Caption = "Saisie Temps"
frm.NavigationButtons = True frm.NavigationButtons = True
frm.DataEntry = True frm.DataEntry = True
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 200, 1200, 250) Set ctl = CreateControl(sName, acLabel, acDetail, , , 200, 200, 1200, 250)
ctl.Caption = "Projet:" ctl.Caption = "Projet:"
Set ctl = CreateControl(frm.Name, acComboBox, acDetail, , , 1500, 200, 4000, 250) Set ctl = CreateControl(sName, acComboBox, acDetail, , , 1500, 200, 4000, 250)
ctl.ControlSource = "ProjetID" ctl.ControlSource = "ProjetID"
ctl.RowSource = "SELECT ProjetID, Nom FROM tbl_Projets WHERE Actif=True" ctl.RowSource = "SELECT ProjetID, Nom FROM tbl_Projets WHERE Actif=True"
ctl.ColumnCount = 2 ctl.ColumnCount = 2
ctl.ColumnWidths = "0;3500" ctl.ColumnWidths = "0;3500"
ctl.BoundColumn = 1 ctl.BoundColumn = 1
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 550, 1200, 250) Set ctl = CreateControl(sName, acLabel, acDetail, , , 200, 550, 1200, 250)
ctl.Caption = "Date:" ctl.Caption = "Date:"
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 550, 1800, 250) Set ctl = CreateControl(sName, acTextBox, acDetail, , , 1500, 550, 1800, 250)
ctl.ControlSource = "Date" ctl.ControlSource = "DateEntree"
ctl.DefaultValue = "=Date()" ctl.DefaultValue = "=Date()"
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 900, 1200, 250) Set ctl = CreateControl(sName, acLabel, acDetail, , , 200, 900, 1200, 250)
ctl.Caption = "Duree:" ctl.Caption = "Duree:"
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 900, 1000, 250) Set ctl = CreateControl(sName, acTextBox, acDetail, , , 1500, 900, 1000, 250)
ctl.ControlSource = "Duree" ctl.ControlSource = "Duree"
Set ctl = CreateControl(frm.Name, acLabel, acDetail, , , 200, 1250, 1200, 250) Set ctl = CreateControl(sName, acLabel, acDetail, , , 200, 1250, 1200, 250)
ctl.Caption = "Notes:" ctl.Caption = "Notes:"
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1500, 1250, 4000, 600) Set ctl = CreateControl(sName, acTextBox, acDetail, , , 1500, 1250, 4000, 600)
ctl.ControlSource = "Description" ctl.ControlSource = "Description"
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 200, 2000, 1500, 400) Set ctl = CreateControl(sName, acCommandButton, acDetail, , , 200, 2000, 1500, 400)
ctl.Caption = "Enregistrer" ctl.Caption = "Enregistrer"
ctl.OnClick = "=SaveAndNew()" ctl.OnClick = "=SaveAndNew()"
Set ctl = CreateControl(frm.Name, acCommandButton, acDetail, , , 1900, 2000, 1500, 400) Set ctl = CreateControl(sName, acCommandButton, acDetail, , , 1900, 2000, 1500, 400)
ctl.Caption = "Retour" ctl.Caption = "Retour"
ctl.OnClick = "=OpenFormAccueil()" ctl.OnClick = "=OpenFormAccueil()"
DoCmd.Close acForm, frm.Name, acSaveYes DoCmd.Close acForm, sName, acSaveYes
DoCmd.Rename "frm_SaisieTemps", acForm, frm.Name DoCmd.Rename "frm_SaisieTemps", acForm, sName
Exit Sub
ErrHandler:
MsgBox "Erreur Saisie: " & Err.Description, vbCritical
End Sub End Sub
Public Sub BuildFormHistorique() Public Sub BuildFormHistorique()
On Error GoTo ErrHandler Dim frm As Form, ctl As Control, sName As String
Dim frm As Form, ctl As Control
On Error Resume Next On Error Resume Next
DoCmd.DeleteObject acForm, "frm_Historique" DoCmd.DeleteObject acForm, "frm_Historique"
On Error GoTo ErrHandler On Error GoTo 0
Set frm = CreateForm() 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" sName = frm.Name
frm.RecordSource = "tbl_Temps"
frm.Caption = "Historique" frm.Caption = "Historique"
frm.DefaultView = 2 frm.DefaultView = 1
frm.AllowEdits = False frm.AllowEdits = False
frm.AllowAdditions = False frm.AllowAdditions = False
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 100, 100, 1500, 250) frm.AllowDeletions = False
ctl.ControlSource = "Client" frm.Section(acDetail).Height = 300
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 1700, 100, 1500, 250) Set ctl = CreateControl(sName, acTextBox, acDetail, , , 100, 20, 1200, 250)
ctl.ControlSource = "Projet" ctl.ControlSource = "DateEntree"
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 3300, 100, 1200, 250) Set ctl = CreateControl(sName, acTextBox, acDetail, , , 1400, 20, 800, 250)
ctl.ControlSource = "Date"
Set ctl = CreateControl(frm.Name, acTextBox, acDetail, , , 4600, 100, 800, 250)
ctl.ControlSource = "Duree" ctl.ControlSource = "Duree"
Set ctl = CreateControl(frm.Name, acCommandButton, acHeader, , , 200, 200, 1500, 400) Set ctl = CreateControl(sName, acTextBox, acDetail, , , 2300, 20, 3500, 250)
ctl.ControlSource = "Description"
Set ctl = CreateControl(sName, acCommandButton, acDetail, , , 6000, 20, 1000, 250)
ctl.Caption = "Retour" ctl.Caption = "Retour"
ctl.OnClick = "=OpenFormAccueil()" ctl.OnClick = "=OpenFormAccueil()"
DoCmd.Close acForm, frm.Name, acSaveYes DoCmd.Close acForm, sName, acSaveYes
DoCmd.Rename "frm_Historique", acForm, frm.Name DoCmd.Rename "frm_Historique", acForm, sName
Exit Sub
ErrHandler:
MsgBox "Erreur Historique: " & Err.Description, vbCritical
End Sub End Sub

View File

@ -2,64 +2,41 @@ Attribute VB_Name = "mod_Navigation"
Option Compare Database Option Compare Database
Option Explicit Option Explicit
'=============================================================================== Public Function OpenFormAccueil() As Boolean
' Module: mod_Navigation
' Description: Fonctions de navigation entre formulaires
' Auteur: Alexis Trouve
' Date: 2025-12-30
'===============================================================================
Public Sub OpenFormAccueil()
DoCmd.OpenForm "frm_Accueil" DoCmd.OpenForm "frm_Accueil"
End Sub OpenFormAccueil = True
End Function
Public Sub OpenFormClients(Optional ByVal clientID As Long = 0) Public Function OpenFormClients() As Boolean
DoCmd.OpenForm "frm_Clients" DoCmd.OpenForm "frm_Clients"
If clientID > 0 Then OpenFormClients = True
Forms!frm_Clients.Recordset.FindFirst "ClientID = " & clientID End Function
End If
End Sub
Public Sub OpenFormProjets(Optional ByVal clientID As Long = 0) Public Function OpenFormProjets() As Boolean
Dim strFilter As String DoCmd.OpenForm "frm_Projets"
If clientID > 0 Then OpenFormProjets = True
strFilter = "ClientID = " & clientID End Function
DoCmd.OpenForm "frm_Projets", , , strFilter
Else
DoCmd.OpenForm "frm_Projets"
End If
End Sub
Public Sub OpenFormSaisieTemps(Optional ByVal projetID As Long = 0) Public Function OpenFormSaisieTemps() As Boolean
DoCmd.OpenForm "frm_SaisieTemps" DoCmd.OpenForm "frm_SaisieTemps"
If projetID > 0 Then OpenFormSaisieTemps = True
Forms!frm_SaisieTemps!cboProjet = projetID End Function
End If
End Sub
Public Sub OpenFormHistorique() Public Function OpenFormHistorique() As Boolean
DoCmd.OpenForm "frm_Historique" DoCmd.OpenForm "frm_Historique"
End Sub OpenFormHistorique = True
End Function
Public Sub CloseCurrentForm() Public Function CloseCurrentForm() As Boolean
DoCmd.Close acForm, Screen.ActiveForm.Name DoCmd.Close acForm, Screen.ActiveForm.Name
End Sub CloseCurrentForm = True
End Function
Public Sub CloseAllForms() Public Function RefreshCurrentForm() As Boolean
Dim frm As Form
For Each frm In Forms
DoCmd.Close acForm, frm.Name
Next frm
End Sub
Public Sub RefreshCurrentForm()
Screen.ActiveForm.Requery Screen.ActiveForm.Requery
End Sub RefreshCurrentForm = True
End Function
'-------------------------------------------------------------------------------
' Function: GoToNewRecord
' Description: Navigue vers un nouvel enregistrement (pour boutons)
'-------------------------------------------------------------------------------
Public Function GoToNewRecord() As Boolean Public Function GoToNewRecord() As Boolean
On Error GoTo ErrHandler On Error GoTo ErrHandler
DoCmd.GoToRecord , , acNewRec DoCmd.GoToRecord , , acNewRec
@ -70,10 +47,6 @@ ErrHandler:
GoToNewRecord = False GoToNewRecord = False
End Function End Function
'-------------------------------------------------------------------------------
' Function: DeleteCurrentRecord
' Description: Supprime l'enregistrement courant avec confirmation
'-------------------------------------------------------------------------------
Public Function DeleteCurrentRecord() As Boolean Public Function DeleteCurrentRecord() As Boolean
On Error GoTo ErrHandler On Error GoTo ErrHandler
If MsgBox("Voulez-vous supprimer?", vbYesNo + vbQuestion, "Confirmer") = vbYes Then If MsgBox("Voulez-vous supprimer?", vbYesNo + vbQuestion, "Confirmer") = vbYes Then
@ -88,10 +61,6 @@ ErrHandler:
DeleteCurrentRecord = False DeleteCurrentRecord = False
End Function End Function
'-------------------------------------------------------------------------------
' Function: SaveAndNew
' Description: Sauvegarde l'enregistrement et va vers nouveau
'-------------------------------------------------------------------------------
Public Function SaveAndNew() As Boolean Public Function SaveAndNew() As Boolean
On Error GoTo ErrHandler On Error GoTo ErrHandler
DoCmd.RunCommand acCmdSaveRecord DoCmd.RunCommand acCmdSaveRecord