Refactoring ok

source/forms/zf_progress.bas

@@ -15,17 +15,20 @@ Begin Form
     Width =5555
     DatasheetFontHeight =11
     ItemSuffix =2
-    Left =5475
+    Left =-19725
     Top =2430
-    Right =16740
+    Right =-8460
     Bottom =14565
     DatasheetGridlinesColor =14806254
     RecSrcDt = Begin
         0xc9a40f6c4f8ae440
     End
-    Caption ="frmProgression"
-    OnOpen ="[Event Procedure]"
+    Caption ="Progress"
     DatasheetFontName ="Calibri"
+    PrtMip = Begin
+        0x6801000068010000680100006801000000000000201c0000e010000001000000 ,
+        0x010000006801000000000000a10700000100000001000000
+    End
     FilterOnLoad =0
     ShowPageMargins =0
     DisplayOnSharePointSite =1
@@ -106,16 +109,18 @@ Begin Form
                     Top =120
                     Width =5205
                     Height =405
-                    FontSize =12
+                    FontSize =10
                     FontWeight =700
                     BorderColor =8355711
                     Name ="txt_title"
                     Caption ="Running..."
+                    FontName ="Verdana"
                     GridlineColor =10921638
                     LayoutCachedLeft =105
                     LayoutCachedTop =120
                     LayoutCachedWidth =5310
                     LayoutCachedHeight =525
+                    ThemeFontIndex =-1
                     ForeTint =100.0
                 End
                 Begin Label
@@ -125,14 +130,17 @@ Begin Form
                     Top =636
                     Width =5158
                     Height =742
+                    FontSize =10
                     BorderColor =8355711
                     Name ="txt_msg"
                     Caption ="..."
+                    FontName ="Verdana"
                     GridlineColor =10921638
                     LayoutCachedLeft =123
                     LayoutCachedTop =636
                     LayoutCachedWidth =5281
                     LayoutCachedHeight =1378
+                    ThemeFontIndex =-1
                     ForeTint =100.0
                 End
                 Begin Rectangle
@@ -183,10 +191,11 @@ Begin Form
                     Top =1927
                     Width =850
                     Height =340
-                    FontWeight =700
+                    FontSize =9
                     Name ="btn_ok"
                     Caption ="OK"
                     OnClick ="[Event Procedure]"
+                    FontName ="Verdana"
                     LeftPadding =60
                     RightPadding =75
                     BottomPadding =120
@@ -197,12 +206,14 @@ Begin Form
                     LayoutCachedWidth =5272
                     LayoutCachedHeight =2267
                     ForeTint =100.0
+                    UseTheme =0
                     BackColor =0
                     BackThemeColorIndex =0
                     BackTint =100.0
                     BorderColor =0
                     BorderThemeColorIndex =0
                     BorderTint =100.0
+                    ThemeFontIndex =-1
                     HoverColor =3355443
                     HoverThemeColorIndex =0
                     HoverTint =80.0
@@ -216,7 +227,10 @@ Begin Form
                     Shadow =-1
                     QuickStyle =22
                     QuickStyleMask =-1
-                    WebImagePaddingTop =1
+                    WebImagePaddingLeft =4
+                    WebImagePaddingTop =2
+                    WebImagePaddingRight =4
+                    WebImagePaddingBottom =7
                 End
             End
         End
@@ -229,10 +243,6 @@ Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
 Option Compare Database
 
-Private Sub boutonOK_Click()
+Private Sub btn_ok_Click()
   DoCmd.Close acForm, Me.name
 End Sub
-
-Private Sub Form_Open(Cancel As Integer)
-  DoCmd.MoveSize 100, 100
-End Sub

source/modules/AT_Access.bas

@@ -7,6 +7,26 @@ Option Compare Database
 
 ' Operations on access objects: tables, queries, forms, reports, macros, modules
 
+Public Sub wait(d As Single)
+    Dim t0 As Single
+    t0 = Timer
+    While Timer - t0 < d
+        DoEvents
+    Wend
+End Sub
+
+Public Sub test()
+    Dim pdial As New ProgressDialog
+
+    pdial.show "My progress bar", "Operation running...", 100, False
+    
+    For i = 0 To 100
+        wait (0.02)
+        pdial.update i, "Operation running..."
+    Next i
+    
+End Sub
+
 Public Function table_exists(tname As String) As Boolean
     Dim td As Object
     

source/modules/AT_BackDB.bas

@@ -1,191 +0,0 @@
-Option Compare Database
-
-' ** Access Toolbox Module **
-' on 2017-02-28,
-' @author: Olivier Massot
-' V 1.0
-
-' Manage external databases
-
-Public Function EtatModeConnexion() As String
-  On Error GoTo err
-  'renvoie le mode de connexion actuel, ou une chaine vide si celui-ci ne peut être determiné
-  Dim table As DAO.TableDef
-  Dim modeConnexion, dirConnexionTable, modeConnexionTable As String
-  Dim compte, compteErr As Integer
-  'à noter: dans la table des bases dorsales, mode de connexion = '*' pour que cette base soit ignorée lors des tests
-  
-  modeConnexion = ""
-  If Not tableExiste("ztblBasesDorsales") Then GoTo errZtbl
-  
-  For Each table In CurrentDb.TableDefs
-    If Len(table.Connect) > 0 Then
-      dirConnexionTable = replace(table.Connect, ";DATABASE=", "")
-      modeConnexionTable = Nz(DFirst("Mode", "ztblBasesDorsales", "[NomBase]='" & extraitNomFichier(dirConnexionTable) & "' AND [rep]='" & repFichier(dirConnexionTable) & "'"), "")
-      If modeConnexionTable = "*" Then
-        'on passe à la suite
-      ElseIf Len(modeConnexionTable) > 0 Then
-        'c'est une table liée
-        If Len(modeConnexion) = 0 Then
-          modeConnexion = modeConnexionTable
-        Else
-          If modeConnexion <> modeConnexionTable Then GoTo errConnexionsIncoherentes
-        End If
-      Else
-        GoTo errBaseIntrouvable
-      End If
-    End If
-  Next table
-  EtatModeConnexion = modeConnexion
-fin:
-    Exit Function
-err:
-   MsgBox "Erreur lors de la détermination du mode de connexion:" & vbNewLine & err.Description
-   GoTo fin
-errZtbl:
-   MsgBox "Erreur lors de la détermination du mode de connexion:" & vbNewLine & "La table ztblBasesDorsales est manquante"
-   GoTo fin
-errBaseIntrouvable:
-   MsgBox "Erreur lors de la détermination du mode de connexion:" & vbNewLine & "La base d'une table est introuvable dans ztblBasesDorsales"
-   GoTo fin
-errConnexionsIncoherentes:
-   MsgBox "Erreur lors de la détermination du mode de connexion:" & vbNewLine & "Connexions incohérentes détectées"
-   GoTo fin
-End Function
-
-Public Sub choisirModeConnexion()
-On Error GoTo err
-  If Not tableExiste("ztblBasesDorsales") Then GoTo errZtbl
-  If Not formExiste("zfrmBasesDorsales") Then GoTo errZfrm
-
-  DoCmd.OpenForm "zfrmBasesDorsales"
-  
-fin:
-Exit Sub
-err:
-  MsgBox "Erreur en cours de procédure:" & err.Description
-  GoTo fin
-errZtbl:
-  MsgBox "Erreur: la table ztblBasesDorsales est nécessaire (cf. FonctionsCommunes.accdb)"
-  GoTo fin
-errZfrm:
-  MsgBox "Erreur: le formulaire zfrmBasesDorsales est nécessaire (cf. FonctionsCommunes.accdb)"
-  GoTo fin
-End Sub
-
-Public Function majConnectionsAppli(ByVal mode As String) As Boolean
-'met à jour les connections de toutes les tables
-  Dim table As DAO.TableDef
-  Dim compte, compteOK As Integer
-  compte = 0
-  compteOK = 0
-  
-  majConnectionsAppli = False
-  
-  If Not tableExiste("ztblBasesDorsales") Then GoTo errZtbl
-  If Not formExiste("zfrmBasesDorsales") Then GoTo errZfrm
-  Application.Echo False
-  DoCmd.Hourglass True
-  
-  If modeValide(mode) = False Then GoTo errModeNonValide
-  
-  For Each table In CurrentDb.TableDefs
-    If Len(table.Connect) > 0 Then
-      'c'est une table liée
-      compte = compte + 1
-      If ConnectMdb(table.name, mode, True) = True Then compteOK = compteOK + 1
-    End If
-  Next table
-If compteOK <> compte Then GoTo errErreursDetectees
-
-majConnectionsAppli = True
-Application.Echo True
-MsgBox "Opération terminée"
-fin:
-  Application.Echo True
-  DoCmd.Hourglass False
-  Exit Function
-err:
-  MsgBox "Erreur en cours de procédure:" & err.Description
-  GoTo fin
-errZtbl:
-  MsgBox "Erreur: la table ztblBasesDorsales est nécessaire (cf. FonctionsCommunes.accdb)"
-  GoTo fin
-errZfrm:
-  MsgBox "Erreur: le formulaire zfrmBasesDorsales est nécessaire (cf. FonctionsCommunes.accdb)"
-  GoTo fin
-errErreursDetectees:
-  MsgBox "Erreur: certaines attaches ne sembles pas avoir été mises à jour correctement"
-  GoTo fin
-errModeNonValide:
-  MsgBox "Erreur: ce mode n'est pas reconnu"
-  GoTo fin
-End Function
-
-Private Function ConnectMdb(ByVal tbl As String, ByVal mode As String, Optional silencieuse As Boolean = False) As Boolean
-'met à jour la connexion de la table selon le mode de branchement demandé
-On Error GoTo err
-Dim bdd As DAO.Database
-Dim td As DAO.TableDef
-Dim connexion, nouveauRep, fichier As String
-ConnectMdb = False
-
-If Not tableExiste(tbl) Then GoTo errTableManq
-
-Set bdd = CurrentDb
-Set td = bdd.TableDefs(tbl)
-
-connexion = Nz(td.Connect, "")       'etat de la connexion actuelle
-If Len(connexion) = 0 Then GoTo errMajLien
-
-fichier = extraitNomFichier(connexion)
-If Nz(DFirst("Mode", "ztblBasesDorsales", "[NomBase]='" & fichier & "'"), "") = "*" Then GoTo reussite
-nouveauRep = Nz(DFirst("Rep", "ztblBasesDorsales", "[Mode]='" & mode & "' and [NomBase]='" & fichier & "'"), "")
-If Len(nouveauRep) = 0 Or Dir(nouveauRep, vbDirectory) = "" Then GoTo errRep
-If Right(nouveauRep, 1) <> "\" Then nouveauRep = nouveauRep & "\"
-
-' Modifie la propriété Connect avec la nouvelle chaîne de connexion
- td.Connect = ";DATABASE=" & nouveauRep & fichier
-'Met à jour la liaison
- td.RefreshLink
- 
-reussite:
- ConnectMdb = True
-fin:
-  If Len(msgErr) > 0 Then
-    If silencieuse = True Then
-      Debug.Print msgErr
-    Else
-      MsgBox msgErr
-    End If
-  End If
-  Set td = Nothing
-  Set db = Nothing
-  Exit Function
-errTableManq:
-  msgErr = "Impossible de mettre à jour la connexion de " & tbl & ": table introuvable"
-  GoTo fin
-err:
-  msgErr = "Impossible de mettre à jour la connexion de " & tbl & ": " & err.Description
-  GoTo fin
-errMajLien:
-  msgErr = "Impossible de mettre à jour la connexion de " & tbl & ": impossible de déterminer l'état actuel de la connexion de la table, ce n'est peut-être pas une table liée"
-  GoTo fin
-errRep:
-  msgErr = "Impossible de mettre à jour la connexion de " & tbl & ": répertoire cible invalide"
-  GoTo fin
-End Function
-
-Private Function modeValide(ByVal mode As String) As Boolean
-On Error GoTo fin
-  modeValide = False
-  modeValide = (DCount("Mode", "ztblBasesDorsales", "[Mode]='" & mode & "'") > 0)
-fin:
-End Function
-
-Public Function modeConnexionParDefaut()
-On Error GoTo fin
-  modeConnexionParDefaut = ""
-  modeConnexionParDefaut = Nz(DFirst("ModeDefaut", "ztblUtilisateurs", "[login]='" & CurrentUser & "'"), "")
-fin:
-End Function

source/modules/AT_Collections.bas

@@ -20,12 +20,25 @@ Public Function concat(ByRef iterable As Variant, Optional separator As String =
 End Function
 
 Function contains(ByRef iterable As Variant, value As Variant) As Boolean
-    Dim var As Variant
+    Dim i As Integer
     contains = False
-    For Each var In iterable
-        If var = value Then
+    If is_empty(iterable) Then Exit Function
+    For i = LBound(iterable) To UBound(iterable)
+        If iterable(i) = value Then
             contains = True
             Exit Function
         End If
-    Next var
+    Next i
+End Function
+
+Public Function is_empty(iterable As Variant) As Boolean
+Dim var As Variant
+is_empty = True
+
+On Error Resume Next
+var = UBound(Tableau)
+On Error GoTo 0
+
+is_empty = IsEmpty(var)
+
 End Function

source/modules/AT_FileDialog.bas

@@ -35,7 +35,7 @@ Public Function FileDialog(Optional ByVal title As String = "Select File(s)", _
        fd.FilterIndex = 2
     End If
     
-    If fd.Show() Then
+    If fd.show() Then
     
       For Each vFilename In fd.SelectedItems
         If Len(FileDialog) > 0 Then FileDialog = FileDialog & separator
@@ -59,7 +59,7 @@ Public Function DirectoryDialog(Optional ByVal title As String = "Select a direc
     
     fd.title = title
     fd.InitialFileName = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(directory)
-    If fd.Show() Then
+    If fd.show() Then
       DirectoryDialog = fd.SelectedItems(1) & "\"
     End If
     Set fd = Nothing

source/modules/AT_Mail.bas

@@ -32,18 +32,18 @@ Public Sub send_mail(ByVal subject As String, _
     
     If is_html = True Then
       If signature = True Then
-        objMail.Display
+        objMail.display
         objMail.HTMLBody = content & vbNewLine & objMail.HTMLBody
         If auto_send Then objMail.Close olDiscard
       Else
         objMail.HTMLBody = content
-        If Not auto_send Then objMail.Display
+        If Not auto_send Then objMail.display
       End If
       objMail.BodyFormat = olFormatHTML
     Else
       objMail.Body = content
       objMail.BodyFormat = olFormatRichText
-      If Not auto_send Then objMail.Display
+      If Not auto_send Then objMail.display
     End If
     
     If Len(attachment) > 0 Then

source/modules/Demarrage.bas

@@ -1,95 +0,0 @@
-Option Compare Database
-'Version 1 du module
-
-
-Public Sub ChargementMenu()
-'à lancer à l'ouverture de l'application à l'ouverture du menu
-' peut aussi être lancee par le biais d'une macro nommée "AutoExec", mais doit être modifiée
-'lance les différentes vérifications avant lancement: attaches des tables, version, autre
-Dim menu As String
-Dim msg, modeConnexion, connexionParDefaut As String
-Dim VersionAJour, connexionOk As Boolean
-
-'le formulaire menu doit posséder les objets suivants:
-'etiquette: lbVersion
-'etiquette: statVersion
-'bouton: cmdMajConnexion
-'etiquette: txtModeConnexion
-
-    DoCmd.RunCommand acCmdAppRestore
-    DoCmd.RunCommand acCmdAppMaximize
-
-    menu = "frm_Menu"
-
-    '*** utilisateur, droits
-    'on vérifie que l'utilisateur existe dans la base
-    DoCmd.SetWarnings False
-    If Not DCount("login", "ztblUtilisateurs", "[login]='" & CurrentUser & "'") > 0 Then
-      'première connexion
-      DoCmd.RunSQL "INSERT INTO ztblUtilisateurs ( Nom, Login, DroitValid, Admin, ModeDefaut, Notes ) " & _
-                   "SELECT '" & CurrentUser & "' AS Expr1, '" & CurrentUser & "' AS Expr2, False AS Expr3, False AS Expr4, " & _
-                   "'" & EtatModeConnexion & "' AS Expr6, '' AS Expr7;"
-    Else
-      If Len(modeConnexionParDefaut) = 0 Then
-         DoCmd.RunSQL "UPDATE ztblUtilisateurs SET ztblUtilisateurs.ModeDefaut = '" & EtatModeConnexion & "' " & _
-                      "WHERE (((ztblUtilisateurs.Login)='" & CurrentUser & "'));"
-      End If
-    End If
-    DoCmd.SetWarnings True
-    '***
-
-    '***verification du mode de connexion
-    modeConnexion = EtatModeConnexion()
-    connexionParDefaut = modeConnexionParDefaut()
-    If modeConnexion <> connexionParDefaut Then
-      If estAdmin = False Then
-        MsgBox "Attention: les tables ne sont pas correctement attachées." & vbNewLine & _
-               "Veuillez patienter pendant que les liens sont remis à jour"
-        connexionOk = majConnectionsAppli(connexionParDefaut)
-        modeConnexion = EtatModeConnexion()
-      Else
-        If MsgBox("[ADMIN] Attention: votre mode de connexion est " & modeConnexion & vbNewLine & _
-               "Voulez vous revenir à la connexion par défaut? (" & connexionParDefaut & ")", vbYesNo) = vbYes Then
-           Call majConnectionsAppli(connexionParDefaut)
-           modeConnexion = EtatModeConnexion()
-        End If
-      End If
-    Else
-      connexionOk = True
-    End If
-    
-    If connexionOk = False And estAdmin = False Then
-       MsgBox "Erreur de conexion aux tables: veuillez contacter un administrateur"
-       Application.Quit
-    End If
-    forms(menu).cmdMajConnexion.Visible = estAdmin
-    forms(menu).txtModeConnexion.Caption = modeConnexion
-    '***
-
-    '*** controle de la version (si appli connectée au réseau (ou autre connexion par défaut)):
-    If modeConnexion = connexionParDefaut Then
-       VersionAJour = VerificationVersion()
-       If VersionAJour = True Then
-         msg = "Version à jour"
-       Else
-         msg = "(!) VOTRE VERSION DE L'APPLICATION N'EST PAS A JOUR (!)"
-         Call Mail_Maj  'propose l'envoi d'un mail de mise à jour
-       End If
-
-       If VersionAJour = False And estAdmin() = False Then Application.Quit
-       forms(menu).statVersion.Caption = msg
-    End If
-    
-    forms(menu).lbVersion.Caption = "Version " & Nz(DLookup("[Valeur]", "[tbl_parametre]", "[Parametre]='VERSION_lb'"), "x") & _
-                       " du " & Nz(DLookup("[Valeur]", "[tbl_parametre]", "[Parametre]='VERSION'"), "?")
-    '***
-
-    
-    
-    '*** autres procédures
-    If modeConnexion = connexionParDefaut Then
-       '...
-    End If
-    '***
-
-End Sub

source/modules/FichierTXT.bas

@@ -1,67 +0,0 @@
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Option Compare Database
-Option Explicit
-'******
-' Lecture/ecriture d'un fichier .txt, utilisé entre autre pour le déboguage de procédure
-' v 1
-'******
-Private locRef As Variant
-Private locCheminFichier As String
-Property Let cheminFichier(chemin As String)
-  locCheminFichier = chemin
-End Property
-Property Get cheminFichier() As String
-  cheminFichier = locCheminFichier
-End Property
-
-Public Sub creer(Optional chemin As String = "")
-On Error GoTo errInc
-Dim ref As Variant
-  'chemin complet du fichier de destination
-  If Len(chemin) > 0 Then locCheminFichier = chemin
-  'le chemin a été renseigné
-  If Not Len(locCheminFichier) > 0 Then GoTo errChemin
-  'on écrase le fichier s'il existe déjà
-  If Dir(locCheminFichier) <> "" Then Kill locCheminFichier
-  'ouverture du fichier
-  locRef = FreeFile(1)
-  Open locCheminFichier For Append Access Write Shared As locRef
-
-fin:
-
-  Exit Sub
-errChemin:
-  MsgBox "FichierTXT: impossible de créer le fichier, un chemin valide doit être renseigné"
-  GoTo fin
-errInc:
-  MsgBox "FichierTXT: impossible de créer le fichier:" & vbNewLine & err.Description
-  GoTo fin
-End Sub
-
-Public Sub ecrire(txt As String)
-'ajoute une ligne au fichier
-On Error GoTo err
-  Print #locRef, txt
-fin:
-  Exit Sub
-err:
-  MsgBox "FichierTXT: impossible d'ajouter la ligne demandée:" & vbNewLine & err.Description
-  GoTo fin
-End Sub
-
-Public Sub fermer()
-On Error GoTo fin
-  'on ferme le fichier s'il ne l'est pas déjà
-  Close #locRef
-fin:
-End Sub
-
-Private Sub class_Terminate()
-On Error GoTo fin
-  'on ferme le fichier s'il ne l'est pas déjà
-  Close #locRef
-fin:
-End Sub

source/modules/ProgressDialog.bas

@@ -0,0 +1,97 @@
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Compare Database
+Option Explicit
+
+' ** Access Toolbox Module **
+' on 2017-02-28,
+' @author: Olivier Massot
+' V 1.0
+
+' Progress Dialog
+
+' ! Requires the 'zf_progress' form
+
+' usage:
+'
+'    Dim pdial As New ProgressDialog
+'
+'    pdial.show "My progress bar", "Operation running...", 100, False
+'
+'    For i = 0 To 100
+'
+'        ' ongoing work...
+'
+'        pdial.update i, "Operation running..."
+'    Next i
+
+Private Const fname = "zf_progress"
+Private total_prog, current_prog As Double
+Private auto_close As Boolean
+
+
+Public Sub show(title As String, Optional msg As String = "", Optional v_total_prog As Double = 100, Optional v_auto_close As Boolean = False)
+
+    auto_close = v_auto_close
+    
+    total_prog = IIf(v_total_prog > 0, v_total_prog, 100)
+    
+    DoCmd.OpenForm fname, acNormal
+    With forms(fname)
+        .txt_title.Caption = title
+        .txt_msg.Visible = (Len(msg) > 0)
+        If Len(msg) > 0 Then .txt_msg.Caption = msg
+        .prog.Width = 1
+        .prog.BackColor = RGB(23, 55, 94)
+    End With
+    DoCmd.Hourglass True
+  
+End Sub
+
+Public Sub update(ByVal prog As Double, ByVal msg As String)
+    Dim ratio As Double
+  
+    If prog >= 0 Then
+        If prog <= total_prog Then
+            current_prog = prog
+        Else
+            current_prog = total_prog
+        End If
+    Else
+        current_prog = 0
+    End If
+  
+    With forms(fname)
+        .SetFocus
+        
+        .txt_msg.Visible = (Len(msg) > 0)
+        If Len(msg) > 0 Then .txt_msg.Caption = CStr(msg)
+        
+        ratio = current_prog / total_prog
+        .prog.Width = 5137 * ratio
+        If ratio = 1 Then
+            If auto_close = True Then
+                Call close_
+                Exit Sub
+            End If
+            DoCmd.Hourglass False
+            .prog.BackColor = RGB(23, 55, 94)
+            .btn_ok.Visible = True
+            .SetFocus
+        End If
+    End With
+    
+end_:
+  Exit Sub
+End Sub
+
+Public Sub close_()
+  DoCmd.Hourglass False
+  DoCmd.Close acForm, fname, acSaveNo
+End Sub
+
+Private Sub class_Terminate()
+  Call close_
+End Sub

source/modules/Progression.bas

@@ -1,95 +0,0 @@
-Attribute VB_GlobalNameSpace = False
-Attribute VB_Creatable = False
-Attribute VB_PredeclaredId = False
-Attribute VB_Exposed = False
-Option Compare Database
-
-Private progTotale, progActuelle As Double
-Private fermetureAuto As Boolean
-'nécessite le formulaire zfrmProgression
-
-Public Sub Afficher(titre As String, Optional msg As String = "", Optional vProgTotale As Double = 1, Optional vfermetureAuto As Boolean = True)
-On Error GoTo err
-  fermetureAuto = vfermetureAuto
-  If Not formExiste("zfrmProgression") Then GoTo errFrm
-  progTotale = IIf(vProgTotale > 0, vProgTotale, 1)
-  
-  DoCmd.OpenForm "zfrmProgression", acNormal
-  With forms![zfrmProgression]
-    .txt_titre.Caption = titre
-    .txt_msg.Visible = (Len(msg) > 0)
-    If Len(msg) > 0 Then .txt_msg.Caption = msg
-    .prog.Width = 1
-    .prog.BackColor = RGB(228, 108, 10)
-  End With
-  DoCmd.Hourglass True
-  
-fin:
-  Exit Sub
-err:
-  DoCmd.Hourglass False
-  MsgBox "Erreur: impossible d'afficher le formulaire de progression"
-  Debug.Print err.Description
-  Call fermer
-  GoTo fin
-errFrm:
-  MsgBox "Erreur: le formulaire zfrmProgression est nécessaire à l'affichage de la progression"
-  Debug.Print err.Description
-  GoTo fin
-End Sub
-
-Public Sub maj(ByVal msg As String, ByVal prog As Double)
-  Dim taux As Double
-  If Not formExiste("zfrmProgression") Then GoTo errFrm
-  If prog >= 0 Then
-    If prog <= progTotale Then
-       progActuelle = prog
-    Else
-       progActuelle = progTotale
-    End If
-  Else
-    progActuelle = 0
-  End If
-  
-  With forms![zfrmProgression]
-    .SetFocus
-    .txt_msg.Visible = (Len(msg) > 0)
-    If Len(msg) > 0 Then .txt_msg.Caption = msg
-    
-    taux = progActuelle / progTotale
-    .prog.Width = 5137 * taux
-    If taux = 1 Then
-       If fermertureAuto = True Then GoTo fermeture
-       DoCmd.Hourglass False
-       .prog.BackColor = RGB(152, 72, 7)
-       .boutonOK.Visible = True
-       .SetFocus
-    End If
-  End With
-fin:
-  Exit Sub
-err:
-  DoCmd.Hourglass False
-  MsgBox "Erreur: impossible de mettre à jour le formulaire de progression"
-  Debug.Print err.Description
-  GoTo fin
-errFrm:
-  DoCmd.Hourglass False
-  GoTo fin
-fermeture:
-  Call fermer
-  GoTo fin
-End Sub
-
-Public Sub fermer()
-On Error GoTo err
-  DoCmd.Hourglass False
-  DoCmd.Close acForm, "zfrmProgression"
-fin:
-  Exit Sub
-err:
-  DoCmd.Hourglass False
-  MsgBox "Erreur: impossible de fermer le formulaire de progression"
-  Debug.Print err.Description
-  GoTo fin
-End Sub

source/modules/TextFile.bas

@@ -0,0 +1,44 @@
+Attribute VB_GlobalNameSpace = False
+Attribute VB_Creatable = False
+Attribute VB_PredeclaredId = False
+Attribute VB_Exposed = False
+Option Compare Database
+Option Explicit
+
+' ** Access Toolbox Module **
+' on 2017-02-28,
+' @author: Olivier Massot
+' V 1.0
+
+' Text File Object
+
+Private loc_ref As Variant
+Private loc_path As String
+
+Property Let path(path As String)
+  loc_path = path
+End Property
+Property Get path() As String
+  path = loc_path
+End Property
+
+Public Sub create_file(Optional path As String = "")
+Dim ref As Variant
+
+  If Len(chemin) > 0 Then loc_path = chemin
+  loc_ref = FreeFile(1)
+  Open loc_path For Append Access Write Shared As locRef
+
+End Sub
+
+Public Sub write_line(str As String)
+  Print #locRef, str
+End Sub
+
+Public Sub close_file()
+  Close #locRef
+End Sub
+
+Private Sub class_Terminate()
+  Close #locRef
+End Sub

source/modules/Chrono.bas → source/modules/TimerObject.bas

@@ -4,37 +4,28 @@ Attribute VB_PredeclaredId = False
 Attribute VB_Exposed = False
 Option Compare Database
 Option Explicit
-'******
-' Chronomètre (pour tests de performances surtout)
-' v 1
-'******
-Private t0 As Single
 
+' ** Access Toolbox Module **
+' on 2017-02-28,
+' @author: Olivier Massot
+' V 1.0
+
+' Timer Class Object
+
+Private t0 As Single
 
 Private Sub class_Initialize()
   t0 = Timer
 End Sub
 
-Public Sub demarrer()
-On Error GoTo err
+Public Sub start()
   t0 = Timer
-Exit Sub
-err:
-MsgBox err.Description
 End Sub
 
-Public Function valeur() As Long
-On Error GoTo err
+Public Function current() As Long
   valeur = 1000 * (Timer - t0)
-Exit Function
-err:
-MsgBox err.Description
 End Function
 
-Public Sub Afficher()
-On Error GoTo err
+Public Sub display()
   Debug.Print 1000 * (Timer - t0) & " ms."
-Exit Sub
-err:
-MsgBox err.Description
 End Sub

source/tables/tbl_parametre.LNKD

@@ -0,0 +1,3 @@
+tbl_parametre
+;DATABASE=C:\dev\access\AGRHum\AGRHum.accdb
+tbl_parametre

source/tables/zt_backdb.xml

@@ -16,13 +16,13 @@
 "/>
 <od:tableProperty name="Orientation" type="2" value="0"/>
 <od:tableProperty name="OrderByOn" type="1" value="0"/>
-<od:tableProperty name="NameMap" type="11" value="CswOVQAAAADQBn1X99bZRb8N9FmVmMTfAAAAAIywbL9U5eRAAAAAAAAAAAB6AHQA
+<od:tableProperty name="NameMap" type="11" value="CswOVQAAAADQBn1X99bZRb8N9FmVmMTfAAAAAF4qrJBs5eRAAAAAAAAAAAB6AHQA
 XwBiAGEAYwBrAGQAYgAAAAAAAAAl+n3CJnr0SaX94fEazx7NBwAAANAGfVf31tlF
-vw30WZWYxN9OAG8AbQBCAGEAcwBlAAAAAAAAAGpIyLhO9gxJj5VBiOaMwxkHAAAA
-0AZ9V/fW2UW/DfRZlZjE300AbwBkAGUAAAAAAAAAnzXCXUEj5UmUFThLoXSDeQcA
-AADQBn1X99bZRb8N9FmVmMTfUgBlAHAAAAAAAAAA9y7JjVMx+kmX5j6WMLRf/gcA
-AADQBn1X99bZRb8N9FmVmMTfZABlAGYAYQB1AGwAdAAAAAAAAAAAAAAAAAAAAAAA
-AAAAAAAADAAAAAUAAAAAAAAAAAAAAAAAAAAAAA==
+vw30WZWYxN9mAGkAbABlAG4AYQBtAGUAAAAAAAAAakjIuE72DEmPlUGI5ozDGQcA
+AADQBn1X99bZRb8N9FmVmMTfbQBvAGQAZQAAAAAAAACfNcJdQSPlSZQVOEuhdIN5
+BwAAANAGfVf31tlFvw30WZWYxN9SAGUAcAAAAAAAAAD3LsmNUzH6SZfmPpYwtF/+
+BwAAANAGfVf31tlFvw30WZWYxN9kAGUAZgBhAHUAbAB0AAAAAAAAAAAAAAAAAAAA
+AAAAAAAAAAAMAAAABQAAAAAAAAAAAAAAAAAAAAAA
 "/>
 <od:tableProperty name="DefaultView" type="2" value="2"/>
 <od:tableProperty name="DisplayViewsOnSharePointSite" type="2" value="1"/>
@@ -44,7 +44,7 @@ AAAAAAAADAAAAAUAAAAAAAAAAAAAAAAAAAAAAA==
 </xsd:annotation>
 <xsd:complexType>
 <xsd:sequence>
-<xsd:element name="NomBase" minOccurs="0" od:jetType="text" od:sqlSType="nvarchar">
+<xsd:element name="filename" minOccurs="0" od:jetType="text" od:sqlSType="nvarchar">
 <xsd:annotation>
 <xsd:appinfo>
 <od:fieldProperty name="GUID" type="9" value="Jfp9wiZ69Eml/eHxGs8ezQ==
@@ -144,21 +144,21 @@ AAAAAAAADAAAAAUAAAAAAAAAAAAAAAAAAAAAAA==
 </xsd:complexType>
 </xsd:element>
 </xsd:schema>
-<dataroot xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" generated="2017-02-28T17:48:07">
+<dataroot xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" generated="2017-03-01T11:26:16">
 <zt_backdb>
-<NomBase>external_db.accdb</NomBase>
+<filename>external_db.accdb</filename>
 <Mode>Test</Mode>
 <Rep>path\to\test\directory\</Rep>
 <default>0</default>
 </zt_backdb>
 <zt_backdb>
-<NomBase>external_db.accdb</NomBase>
+<filename>external_db.accdb</filename>
 <Mode>Production</Mode>
 <Rep>path\to\production\directory\</Rep>
 <default>1</default>
 </zt_backdb>
 <zt_backdb>
-<NomBase>external_db.accdb</NomBase>
+<filename>external_db.accdb</filename>
 <Mode>Other</Mode>
 <Rep>path\to\other\directory\</Rep>
 <default>0</default>