Réalisez un assistant de présaisie pour alimenter la base d'un serveur central

=(NullData([NomDuChamp1];4)+NullData([NomDuChamp2];10)+NullData([NomDuChamp3];10))

=([txtCheckdata]=3)

=([txtCheckdata]=6)

=([txtCheckdata]=2)

=Compte([IDContrat]) & " contrats enregistrés."

=([txtCheckdata]=2)

Option Compare Database
Option Explicit

Private Const NEXT_FORM_ID                             As Integer = 1
Private Const FORM_CAPTION                             As String = "Écran d'accueil"

Private Sub Form_Load()
'On désactive les alertes système
    DoCmd.SetWarnings False
    'On réinitialise les variables et les contrôles
    Me.chkRAZData = False
    g_strDataPage = ""
    'On efface le tableau des étapes
    Erase g_intCompletionIndex
    Me.Caption = FORM_CAPTION
End Sub

Option Compare Database
Option Explicit

Private Const PREVIOUS_FORM_ID                         As Integer = 0
Private Const NEXT_FORM_ID                             As Integer = 2
Private Const TARGET_TABLE                             As String = "tblSites"
Private Const FIELD_COLLECTION                         As String = "NoSite;LibelleSite;IDCommune;DateOuverture"
Private Const RECORD_SOURCE                            As String = "SELECT * FROM " & TARGET_TABLE
Private Const DELETE_RECORD_SQL                        As String = "DELETE * FROM " & TARGET_TABLE & " "
Private Const WHERE_CONDITION                          As String = "WHERE NoSite = #1"
Private Const FORM_CAPTION                             As String = "Saisie des données : étape #1/" & MAX_STEP_WIZ

Private Const FORM_SUBJECT                             As String = "du Site"
Private Const FORM_TITLE As String = " Assistant de saisie des données " & FORM_SUBJECT

Private Sub Form_Load()
'Le formulaire est raccordé à la source de données de la constante
    Me.RecordSource = RECORD_SOURCE
    'On applique le titre de la barre de titre dynamiquement
    Me.Caption = Replace(FORM_CAPTION, "#1", NEXT_FORM_ID - 1)
    'On applique le titre de la fenêtre dynamiquement
    Me.lblTitle.Caption = FORM_TITLE
    'On appelle InitIDCommune()
    Call InitIDCommune
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
Dim strErrMessage                                      As String
    'On appelle FormDataErrors() selon DataErr si une erreur est rencontrée 
    If FormDataErrors(DataErr, strErrMessage, Response, Me) Then
        MsgBox strErrMessage, vbExclamation, "Erreur de saisie"
        Me.ActiveControl.Undo
    End If
End Sub

Option Compare Database
Option Explicit

Private Const PREVIOUS_FORM_ID                         As Integer = 1
Private Const NEXT_FORM_ID                             As Integer = 3
Private Const TARGET_TABLE                             As String = "tblPersonnel"
Private Const FIELD_COLLECTION                         As String = "NoSite;Prenom;NomFamille;Email;Login;IDPrivileges"
Private Const RECORD_SOURCE                            As String = "SELECT * FROM " & TARGET_TABLE & ";"
Private Const DELETE_RECORD_SQL                        As String = "DELETE * FROM " & TARGET_TABLE & " "
Private Const WHERE_CONDITION                          As String = "WHERE IDPersonne = #1 AND NoSite = '#2'"
Private Const FORM_CAPTION                             As String = "Saisie des données : étape #1/" & MAX_STEP_WIZ

Private Const FORM_SUBJECT                             As String = "des employés rattachés au Site"
Private Const FORM_TITLE As String = " Assistant de saisie des données " & FORM_SUBJECT

Private Sub Form_Current()
'On appelle la procédure événementielle générique du même nom
    Call FormCurrent(Me, "Prenom")
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
Dim strErrMessage                                      As String
    'On appelle FormDataErrors() selon DataErr si une erreur est rencontrée 
    If FormDataErrors(DataErr, strErrMessage, Response, Me) Then
        MsgBox strErrMessage, vbExclamation, "Erreur de saisie"
        Me.ActiveControl.Undo
    End If
End Sub

Private Sub Form_Load()
'On désactive les alertes
    DoCmd.SetWarnings False
    'On masque ou affiche les contrôles selon le mode (Prod ou Test)
    Me.txtTotalRows.Visible = SHOW_HIDDEN_CONTROLS
    Me.txtNoSite.Visible = SHOW_HIDDEN_CONTROLS
    Me.txtIDPersonne.Visible = SHOW_HIDDEN_CONTROLS
    Me.txtNomPrenom.Visible = SHOW_HIDDEN_CONTROLS
    Me.txtTotalRows.Visible = SHOW_HIDDEN_CONTROLS
    Me.txtRowCompleted.Visible = SHOW_HIDDEN_CONTROLS

    'Le formulaire est raccordé à la source de données de la constante
    Me.RecordSource = RECORD_SOURCE
    'On applique le titre de la barre de titre dynamiquement
    Me.Caption = Replace(FORM_CAPTION, "#1", NEXT_FORM_ID - 1)
    'On applique le titre de la fenêtre dynamiquement
    Me.lblTitle.Caption = FORM_TITLE
End Sub

Private Sub Form_Timer()
    'On provoque un clignotement du texte de complétion des données
    Me.lblRecCompleted.Visible = Not lblRecCompleted.Visible
End Sub

Option Compare Database
Option Explicit

Private Const TARGET_TABLE                             As String = "tblPersonnel"
Private Const RECORD_SOURCE                            As String = "SELECT * FROM " & TARGET_TABLE & ";"

Private Sub Form_Current()
'On appelle la procédure événementielle générique du même nom
    Call SubFormCurrent(Me, "employé", False)
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
'On appelle FormDataErrors() selon DataErr si une erreur est rencontrée 
    SubFormDataError Me, DataErr, Response, "même nom / même prénom / même N° de site"
End Sub

Private Sub Form_Load()
    'On affecte la source de données
    Me.RecordSource = RECORD_SOURCE
End Sub

Option Compare Database
Option Explicit

Private Const PREVIOUS_FORM_ID                         As Integer = 2
Private Const NEXT_FORM_ID                             As Integer = 4
Private Const TARGET_TABLE                             As String = "tblCommunesSite"
Private Const FIELD_COLLECTION                         As String = "IDCommune;NoSite"
Private Const RECORD_SOURCE                            As String = "SELECT * FROM " & TARGET_TABLE & ";"
Private Const DELETE_RECORD_SQL                        As String = "DELETE * FROM " & TARGET_TABLE & " "
Private Const WHERE_CONDITION                          As String = "WHERE IDCommune = #1 AND NoSite = #2"
Private Const FORM_CAPTION                             As String = "Saisie des données : étape #1/" & MAX_STEP_WIZ

Private Const FORM_SUBJECT                             As String = "des communes du site"
Private Const FORM_TITLE                               As String = " Assistant de saisie des données " & FORM_SUBJECT

Private Sub Form_Current()
'On appelle la procédure événementielle générique du même nom
    Call FormCurrent(Me, "IDDepartement")
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
Dim strErrMessage                                      As String
    'On appelle FormDataErrors() selon DataErr si une erreur est rencontrée 
    If FormDataErrors(DataErr, strErrMessage, Response, Me) Then
        MsgBox strErrMessage, vbExclamation, "Erreur de saisie"
        Me.ActiveControl.Undo
    End If
End Sub

Private Sub Form_Load()
'On désactive les alertes
    DoCmd.SetWarnings False
    'On masque ou affiche les contrôles selon le mode (Prod ou Test)
    Me.txtTotalRows.Visible = SHOW_HIDDEN_CONTROLS
    Me.txtIDCommune.Visible = SHOW_HIDDEN_CONTROLS
    Me.txtCommune.Visible = SHOW_HIDDEN_CONTROLS
    Me.txtRowCompleted.Visible = SHOW_HIDDEN_CONTROLS

    'Le formulaire est raccordé à la source de données de la constante
    Me.RecordSource = RECORD_SOURCE
    'On applique le titre de la barre de titre dynamiquement
    Me.Caption = Replace(FORM_CAPTION, "#1", NEXT_FORM_ID - 1)
    'On applique le titre de la fenêtre dynamiquement
    Me.lblTitle.Caption = FORM_TITLE
End Sub

Private Sub Form_Timer()
Dim lngCount                                           As Long
    'On provoque un clignotement du texte de complétion des données
    Me.lblRecCompleted.Visible = Not lblRecCompleted.Visible
End Sub

Option Compare Database
Option Explicit

Private Const TARGET_TABLE                             As String = "tblCommunesSite"
Private Const RECORD_SOURCE                            As String = "SELECT * FROM " & TARGET_TABLE & ";"

Private Sub Form_Current()
'On appelle la procédure événementielle générique du même nom
    Call SubFormCurrent(Me, "cboDepartement", False)
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
'On appelle FormDataErrors() selon DataErr si une erreur est rencontrée 
    SubFormDataError Me, DataErr, Response, "même département / même commune / même N° de site"
End Sub

Private Sub Form_Load()
'On affecte la source de données
    Me.RecordSource = RECORD_SOURCE
End Sub

Option Compare Database
Option Explicit

Private Const PREVIOUS_FORM_ID                         As Integer = 3
Private Const NEXT_FORM_ID                             As Integer = 5
Private Const TARGET_TABLE                             As String = "tblContrats"
Private Const FIELD_COLLECTION                         As String = "IDContrat;LibelleContrat;IDTypeContrat;DateDebut;DateFin"
Private Const RECORD_SOURCE                            As String = "SELECT * FROM " & TARGET_TABLE
Private Const FORM_CAPTION                             As String = "Saisie des données : étape #1/" & MAX_STEP_WIZ

Private Const FORM_SUBJECT                             As String = "des Contrats"
Private Const FORM_TITLE As String = " Assistant de saisie des données " & FORM_SUBJECT

Private Sub Form_Error(DataErr As Integer, Response As Integer)
Dim strErrMessage                                      As String
    'On appelle FormDataErrors() selon DataErr si une erreur est rencontrée 
    If FormDataErrors(DataErr, strErrMessage, Response, Me) Then
        MsgBox strErrMessage, vbExclamation, "Erreur de saisie"
        Me.ActiveControl.Undo
    End If
End Sub

Private Sub Form_Load()
Dim oRS                                                As DAO.Recordset
Dim lngRecordCount                                     As Long

'Le formulaire est raccordé à la source de données de la constante
    Me.RecordSource = RECORD_SOURCE
    'On applique le titre de la barre de titre dynamiquement
    Me.Caption = Replace(FORM_CAPTION, "#1", NEXT_FORM_ID - 1)
    'On applique le titre de la fenêtre dynamiquement
    Me.lblTitle.Caption = FORM_TITLE
    
    'On compte le nombre de contrats afin de libérer le bouton donnant accès à la liste
    Set oRS = Me.RecordsetClone
    With oRS
        If Not .EOF Then
            .MoveLast
            lngRecordCount = .RecordCount
            .MoveFirst
        End If
        .Close
    End With
    Me.cmdShowExistingContracts.Enabled = (lngRecordCount > 1)
    Set oRS = Nothing
End Sub

Option Compare Database
Option Explicit

Private Sub Form_Load()
    Me.txtFocus.SetFocus
End Sub

Option Compare Database
Option Explicit

Private Const PREVIOUS_FORM_ID                         As Integer = 4
Private Const NEXT_FORM_ID                             As Integer = MAX_STEP_WIZ + 1
Private Const FINAL_FORM_ID                            As Integer = LAST_FORM_INDEX
Private Const TARGET_TABLE                             As String = "tblContratCommunes"
Private Const FIELD_COLLECTION                         As String = "IDCommune;IDContrat"
Private Const RECORD_SOURCE                            As String = "SELECT * FROM " & TARGET_TABLE & ";"
Private Const DELETE_RECORD_SQL                        As String = "DELETE * FROM " & TARGET_TABLE & " "
Private Const WHERE_CONDITION                          As String = "WHERE IDCommune = #1 AND IDContrat = '#2'"
Private Const FORM_CAPTION                             As String = "Saisie des données : étape #1/" & MAX_STEP_WIZ

Private Const FORM_SUBJECT                             As String = "des contrats des communes du site"
Private Const FORM_TITLE As String = " Assistant de saisie des données " & FORM_SUBJECT

Private Sub Form_Error(DataErr As Integer, Response As Integer)
Dim strErrMessage                                      As String
    'On appelle FormDataErrors() selon DataErr si une erreur est rencontrée 
    If FormDataErrors(DataErr, strErrMessage, Response, Me) Then
        MsgBox strErrMessage, vbExclamation, "Erreur de saisie"
        Me.ActiveControl.Undo
    End If
End Sub

Private Sub Form_Load()
'On désactive les alertes
    DoCmd.SetWarnings False
    'On masque ou affiche les contrôles selon le mode (Prod ou Test)
    Me.txtTotalRows.Visible = SHOW_HIDDEN_CONTROLS
    'Me.txtIDCommune.Visible = SHOW_HIDDEN_CONTROLS
    'Me.txtCommune.Visible = SHOW_HIDDEN_CONTROLS
    Me.txtRowCompleted.Visible = SHOW_HIDDEN_CONTROLS

    'Le formulaire est raccordé à la source de données de la constante
    Me.RecordSource = RECORD_SOURCE
    'On applique le titre de la barre de titre dynamiquement
    Me.Caption = Replace(FORM_CAPTION, "#1", NEXT_FORM_ID - 1)
    'On applique le titre de la fenêtre dynamiquement
    Me.lblTitle.Caption = FORM_TITLE
End Sub

Private Sub Form_Timer()
    'On provoque un clignotement du texte de complétion des données
    Me.lblRecCompleted.Visible = Not lblRecCompleted.Visible
End Sub

Private Const TARGET_TABLE                             As String = "tblContratCommunes"
Private Const RECORD_SOURCE                            As String = "SELECT * FROM " & TARGET_TABLE & ";"

Private Sub Form_Current()
'On appelle la procédure événementielle générique du même nom
    Call SubFormCurrent(Me, "Contrat / Communes", False)
End Sub

Private Sub Form_Error(DataErr As Integer, Response As Integer)
'On appelle FormDataErrors() selon DataErr si une erreur est rencontrée 
    SubFormDataError Me, DataErr, Response, "même département / même commune / même N° de site"
End Sub

Private Sub Form_Load()
    'On affecte la source de données
    Me.RecordSource = RECORD_SOURCE
End Sub

Private Const PREVIOUS_FORM_ID                         As Integer = 5
Private Const NEXT_FORM_ID                             As Integer = 0
Private Const FORM_CAPTION                             As String = "Saisie des données  : dernière étape"
Private Const FORM_SUBJECT                             As String = "pour l'ensemble des modules"
Private Const FORM_TITLE                               As String = "Fin de l'Assistant de saisie des données " & FORM_SUBJECT

Private m_blnCompleted                                 As Boolean
Private m_intCount                                     As Integer

Private Sub Form_Load()
'On applique le titre de la barre de titre dynamiquement
    Me.Caption = FORM_CAPTION
    'On applique le titre de la fenêtre dynamiquement
    Me.lblTitle.Caption = FORM_TITLE
    'On initialise la variable selon la résultante de la fonction
    m_blnCompleted = AllStepsAreCompleted(m_intCount)
    'On affiche la liste des étapes manquantes s'il y en a
    If Not m_blnCompleted Then
        Me.lblStepList.Caption = g_strDataPage
        lblStepStatus.Visible = True
    Else
        Me.lblStepList.Caption = "Aucune étape n'a été omise."
        lblStepStatus.Visible = False
    End If
End Sub

Option Compare Database
Option Explicit

Private Const NEXT_FORM_ID                             As Integer = 1
Private Const FORM_CAPTION                             As String = "Écran d'accueil"

Private Sub cmdQuit_Click()
Dim strMsgData                                         As String
Dim intCount                                           As Integer
    'Appelle la fonction pour déterminer si toutes les étapes sont complétées
    If AllStepsAreCompleted(intCount) Then
        'La chaîne prend alors le message correspondant (ici positif)
        strMsgData = vbCrLf & vbCrLf & "Tous les modules sont complétés"
    Else
        'La chaîne prend alors le message correspondant (ici négatif)
        strMsgData = vbCrLf & vbCrLf & "Toutes les données n'ont pas été saisies." & vbCrLf & vbCrLf & IIf(intCount = 0, "Aucune étape n'a été correctement remplie !", Trim(str(intCount)) & " étape(s) a été correctement remplie(s) sur un total de " & MAX_STEP_WIZ & ".")
    End If
    'On demande confirmation avant de quitter l'application
    If MsgBox("Êtes-vous certain de vouloir quitter ?" & strMsgData, vbQuestion + vbYesNo + vbDefaultButton2, "Quitter") = vbYes Then
        Application.Quit acQuitSaveAll
    End If
End Sub

Private Sub cmdStart_Click()
Dim strErrDescription                                  As String

    On Error GoTo L_ErrcmdStart_Click
    'Si la remise à blanc des données est demandée...
    If Nz(Me.chkRAZData, False) Then
        'On confirme par un message la remise à blanc avant de passer la première étape
        Select Case MsgBox("Êtes-vous certain de vouloir supprimer toutes les données déjà inscrites avant de continuer ?" & vbCrLf & _
                           "Cette action est irréversible...", vbExclamation + vbYesNoCancel + vbDefaultButton2, "Effacer toutes les données")
            Case vbYes
                'On appelle la fonction qui retourne un succès ou un échec
                If EraseAllDataBefore(strErrDescription) = False Then
                    'On génère l'erreur d'exécution si la fonction échoue
                    Err.Raise 17, "Remise à blanc", strErrDescription
                End If
            Case vbCancel
                'On ne fait rien
                Exit Sub
            Case Else
        End Select
    End If
    'On ferme cet écran
    DoCmd.Close acForm, Me.Name
    'On ouvre l'écran de l'étape 1
    DoCmd.OpenForm FORM_DATA_WIZ & NEXT_FORM_ID, , , , , acDialog

    On Error GoTo 0
L_ExcmdStart_Click:
    Exit Sub

L_ErrcmdStart_Click:
    MsgBox Err.Description, vbExclamation, Err.Source
    Resume L_ExcmdStart_Click
End Sub

Private Sub InitIDCommune()
Dim strIDDepartement                                   As String
    'Vérifie si une commune a déjà été spécifiée et agit en conséquence sur
    'la zone modifiable (qui est indépendante) qui contient les départements 
    With Me.IDCommune
        If Nz(.Value, 0) Then
            strIDDepartement = .Column(2)
            .Enabled = True
        End If
    End With
    Me.cboDeptRegion.Value = strIDDepartement
End Sub

'**********************************************************************
' Module            : basFormsFunctions
' Type              : Module
' DateTime          : 30/07/2015
' Author            : Argyronet
' Review            : 23/09/2015 - Jean-Philippe AMBROSINO
' Review date       : 27/11/2015
' Purpose           : Module contenant les procédures et fonctions génériques [événementielles] des formulaires
'**********************************************************************
Option Compare Database
Option Explicit

Public Sub FormCurrent(ByRef TargetForm As Form, ByVal FirstControl As String)
'---------------------------------------------------------------------------
' Sub       : FormCurrent
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Procédure générique de substitution de l'événement Current d'un formulaire simple
'...........................................................................
' Parameters    : TargetForm : Formulaire cible
'                 FirstControl : Nom du 1er contrôle

' Return Codes  :  None
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Dim oSubForm                                           As SubForm
Dim oControl                                           As Control

    With TargetForm
        'On définit le sous-formulaire
        Set oSubForm = .Form(SUBFORM_DATA_WIZ)
        'On donne le focus au sous-formulaire
        With oSubForm
            .SetFocus
            On Error Resume Next
            'On pointe le dernier enregistrement s'il en existe (erreur optimiste)
            DoCmd.GoToRecord , , acLast
            'On définit le contrôle auquel donner le focus
            Set oControl = .Controls(FirstControl)
            oControl.SetFocus
        End With
    End With
    'Libération des objets
    Set oControl = Nothing
    Set oSubForm = Nothing
End Sub

Public Sub SubFormCurrent(ByRef TargetSubForm As Form, ByVal ItemData As String, ByVal IsFemale As Boolean)
'---------------------------------------------------------------------------
' Sub       : SubFormCurrent
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Procédure générique de substitution de l'événement Current d'un formulaire simple
'...........................................................................
' Parameters    : TargetForm : Formulaire cible
'                 ItemData : Sujet du contenu
'                 IsFemale : True pour changer le genre des textes

' Return Codes  :  None
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Dim lngCount                                           As Long
Dim blnCompleted                                       As Boolean

    'On pose une gestion d'erreurs optimiste contrôlée
    On Error Resume Next
    'On compte le nombre d'enregistrements
    lngCount = Nz(TargetSubForm.txtCountRows, 0)
    'On vérifie si la ligne en cours est complète
    blnCompleted = Nz(TargetSubForm.txtCompleted, False)
    'Il est probable qu'une erreur définie par l'application ou par l'objet soit levée :
    'on la gère de façon optimiste et n'en tient pas compte
    If Err = -2147352567 Then
        MsgBox "Attention..." & vbCrLf & "Vérifier que la source de contrôle du sous-formulaire '" & TargetSubForm.Name & "' est correcte !", vbExclamation, "Message développeur"
        Err.Clear
    End If
    'S'il existe des enregistrements
    If lngCount Then
        With TargetSubForm.Parent
            'On adapte l'intulé  du label avec le nombre
            .lblCountRows.Caption = lngCount & ItemData & "(s) enregistré" & IIf(IsFemale, "e", "") & "(s)"
            With .lblRecCompleted
                'On adapte l'intitulé du label avec le texte et la couleur correspondante
                .Caption = "Ligne " & IIf(blnCompleted, "complète", "incomplète")
                .ForeColor = IIf(blnCompleted, CLR_GREENCOLOR, CLR_REDCOLOR)
            End With
            .cmdDelete.Caption = CMD_DELETE
        End With
    End If
End Sub

Public Sub OpenTheForm(ByVal GotoDirection As ge_FormDirection, ByRef TargetForm As Form, ByVal NextFormID As Long, ByVal PreviousFormID As Long, ByVal TableSource As String, ByVal FieldCollection As String, ByVal FormWithSubForm As Boolean, Optional ByVal IsLastStep As Boolean = False)
'---------------------------------------------------------------------------
' Sub       : OpenTheForm
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Procédure générique de substitution de la méthode OpenForm
'...........................................................................
' Parameters    : GotoDirection : Sens (précédent/suivant)
'                 TargetForm : Formulaire cible
'                 NextFormID : ID du formulaire suivant
'                 PreviousFormID : ID du formulaire précédent
'                 TableSource : Table ou requête source
'                 FieldCollection : Noms des champs utilisés
'                 FormWithSubForm = True s'il y a un sous-formulaire

' Return Codes  :  None
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Dim SQLSelect                                          As String
Dim intFormIndex                                       As Integer

    On Error GoTo L_ErrOpenTheForm

    'On établit la clause Select fondée sur la table source
    SQLSelect = "SELECT * FROM " & TableSource
    'Si l'on vérifie le sous-formulaire...
    If FormWithSubForm Then
        'Si tous les champs du sous-formulaire ne sont pas renseignés...
        If DataSubFormCompleted(TableSource, FieldCollection, False, NextFormID, IsLastStep) = vbNo Then Exit Sub
    Else
        'Si tous les champs du formulaire ne sont pas renseignés...
        If DataFormCompleted(TargetForm, False, FieldCollection, NextFormID, IsLastStep) = vbNo Then Exit Sub
    End If
    'Selon le sens de navigation, on définit la variable de l'index du formulaire cible
    If GotoDirection = GotoNext Then
        intFormIndex = NextFormID
    Else
        intFormIndex = PreviousFormID
    End If
    'On ferme ce formulaire
    DoCmd.Close acForm, TargetForm.Name

    'Si l'on arrive à la dernière étape...
    If IsLastStep Then
        'Dernier identifiant : on ouvre le formulaire de fin
        DoCmd.OpenForm FORM_END, , , , , acDialog
    Else
        'On ouvre le suivant ou précédent
        If intFormIndex Then
            DoCmd.OpenForm FORM_DATA_WIZ & intFormIndex, , , , , acDialog
        Else
            DoCmd.OpenForm FORM_START, , , , , acDialog
        End If
    End If

    On Error GoTo 0
L_ExOpenTheForm:
    Exit Sub

L_ErrOpenTheForm:
    MsgBox Err.Description, vbExclamation, Err.Source
    Resume L_ExOpenTheForm
End Sub

Public Function FormDataErrors(ByVal DataErr As Integer, ByRef Message As String, ByRef Response As Integer, Optional ByRef TargetForm As Form) As Boolean
'---------------------------------------------------------------------------
' Function      : FormDataErrors
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Procédure générique de substitution de l'événement Form_Error
'...........................................................................
' Parameters    : DataErr : Erreur de données
'                 Message : Message de retour
'                 Response : Flag de comportement de la réponse suite à l'erreur
'                 TargetForm : Formulaire cible

' Return Codes  : Boolean = True if success
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Const RESET_VBA_CODE                                   As Integer = 29013
Const INDEX_DOUBLONS                                   As Integer = 3022
Const INPUT_MASK_VIOLATION                             As Integer = 2279
Const NOT_IN_LIST                                      As Integer = 2237
Const INVALID_INPUTMASK                                As Integer = 2113

    Message = vbNullString

    Select Case DataErr
            'Non-respect du masque de saisie
        Case INPUT_MASK_VIOLATION
            Response = acDataErrContinue
            Message = "Attention !" & vbCrLf & "Le masque de saisie du champ doit être respecté."
            'Élément absent de la liste
        Case NOT_IN_LIST
            Response = acDataErrContinue
            Message = "Attention !" & vbCrLf & "Veuillez choisir un élément dans la liste..."
            'Doublon ou tentative d'action de réinitialisation du code en cours d'exécution
        Case INDEX_DOUBLONS, RESET_VBA_CODE
            Response = acDataErrDisplay
            Message = "Attention !" & vbCrLf & "Vous avez déjà saisi ou bien il existe un enregistrement identique dans la base !"
            'Mauvais usage du masque de saisie
        Case INVALID_INPUTMASK
            Response = acDataErrContinue
            Message = "Attention !" & vbCrLf & "La valeur est non valide pour ce champ..." & vbCrLf & vbCrLf & "Vous avez peut-être entré du texte dans un champ numérique ou un nombre supérieur à ce que permet la taille du champ ou encore une date incohérente."
            'Toute autre cause...
        Case Else
            Response = acDataErrContinue
            Message = "Attention !" & vbCrLf & "La valeur que vous avez tapée est incorrecte..."
            If Not TargetForm Is Nothing Then
                With TargetForm.ActiveControl
                    On Error Resume Next
                    'On annule le contenu du champ s'il est accessible
                    .Undo
                    Err.Clear
                    .SetFocus
                End With
            End If
    End Select
    'Valeur de retour
    FormDataErrors = (Response = acDataErrContinue)
End Function

Public Sub SubFormDataError(TargetForm As Form, DataErr As Integer, Response As Integer, ByVal TargetDataName As String)
'---------------------------------------------------------------------------
' Function      : SubFormDataError
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Procédure générique de substitution de l'événement Form_Error pour les sous-formulaires
'...........................................................................
' Parameters    : TargetForm : Formulaire cible
'                 DataErr : Erreur de données
'                 Response : Flag de comportement de la réponse suite à l'erreur
'                 TargetDataName : Sujet de la donnée concernée
'
' Return Codes  : Boolean = True if success
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Const INVALID_INPUTMASK                                As Integer = 2113
Const INDEX_DOUBLONS                                   As Integer = 3022
Const VALUE_IS_REQUIRED                                As Integer = 3314

    Select Case DataErr
        Case INVALID_INPUTMASK
            'Ne devrait jamais arriver sauf si vous avez inversé la colonne liée
            MsgBox "Attention : " & vbCrLf & "Valeur non valide pour ce champ.Vous avez peut-être entré du texte dans un champ numérique ou un nombre supérieur à ce que permet sa taille.", vbExclamation, "Valeur incompatible"
        Case VALUE_IS_REQUIRED
            'Donnée requise
            If MsgBox("Vous devez d'abord inscrire une valeur dans chaque champ." & vbCrLf & vbCrLf & "Voulez-vous annuler cet enregistrement ?", 52, "Ligne incomplète") = 6 Then
                On Error Resume Next
                DoCmd.RunCommand acCmdUndo
                On Error GoTo 0
                With TargetForm.Parent
                    .cmdAdd.Caption = CMD_ADD
                    .cmdDelete.Caption = CMD_DELETE
                End With
            End If
        Case INDEX_DOUBLONS
            'Risque de doublons dans champs index
            MsgBox "Attention : " & vbCrLf & "Vous avez créé un doublon :" & vbCrLf & "(" & TargetDataName & ")." & vbCrLf & "Veuillez modifier votre saisie ou bien annuler la ligne (Echap).", vbExclamation, "Ligne dupliquée"
        Case Else
            'Toute autre raison
            MsgBox "Attention : " & vbCrLf & "Veuillez d'abord compléter la ligne avant de passer à une autre ou d'effectuer une autre opération.", vbExclamation, "Action non conventionnelle"
    End Select
    Response = acDataErrContinue
End Sub

Public Function DataFormCompleted(ByRef TargetForm As Form, ByVal AddNewRecord As Boolean, ByVal FieldControlCollection As String, ByVal NextFormID As Integer, Optional ByVal IsLastStep As Boolean = False) As VbMsgBoxResult
'---------------------------------------------------------------------------
' Function      : DataFormCompleted
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Vérifie que les données du formulaire sont complétées
'...........................................................................
' Parameters    : TargetForm : Formulaire cible
'                 AddNewRecord : True si mode ajout
'                 FieldControlCollection : Liste des champs utilisés
'                 NextFormID : ID du formulaire suivant

' Return Codes  : VbMsgBoxResult = Réponse au Msgbox
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Const ADD_MESSAGE                                      As String = "Avant d'ajouter un nouvel enregistrement, vous devez faire en sorte que l'enregistrement en cours soit complété."
Const ERR_MESSAGE                                      As String = "Avant de changer d'écran, vous devez faire en sorte que ce formulaire possède au moins un enregistrement représentant un site."
Const IGNORE_MESSAGE                                   As String = vbCrLf & vbCrLf & "Voulez-vous ignorer ce message et continuer ?"
Dim strMessage                                         As String
Dim straFieldControlCollection()                       As String
Dim D                                                  As Integer
Dim oControl                                           As Control

    On Error GoTo L_ErrDataFormCompleted
    'On affecte le bon message selon le mode
    If AddNewRecord Then
        strMessage = ADD_MESSAGE & IGNORE_MESSAGE
    Else
        strMessage = ERR_MESSAGE & IGNORE_MESSAGE
    End If
    'Affectation du tableau de champs
    straFieldControlCollection = Split(FieldControlCollection, ";")
    'Pour chacun des champs
    For D = LBound(straFieldControlCollection) To UBound(straFieldControlCollection)
        'On affecte l'objet au contrôle du formulaire
        Set oControl = TargetForm.Controls(straFieldControlCollection(D))
        With oControl
            'S'il est nul
            If IsNull(.Value) Then
                'Si la propriété Remarque spécifie l'interdiction du Null
                If .Tag = "NotNull" Then
                    'On lève une erreur
                    Err.Raise 94, "Donnée requise", strMessage
                End If
            End If
        End With
    Next
    'On enrichit le tableau récapitulatif de vérification
    If IsLastStep Then
        'Si c'est la dernière, on prend l'index de la constante
        Call FillDataChecker(MAX_STEP_WIZ, True)
    Else
        'Celle en cours
        Call FillDataChecker(NextFormID - 1, True)
    End If
    DataFormCompleted = True

    On Error GoTo 0
L_ExDataFormCompleted:
    Set oControl = Nothing
    Exit Function

L_ErrDataFormCompleted:
    'En cas d'erreur (optimiste, on vérifie les data), la fonction retourne un MsgBox
    DataFormCompleted = MsgBox(Err.Description, vbExclamation + vbYesNo, Err.Source)
    'On décrémente le tableau récapitulatif de vérification pour cette étape
    If Not IsLastStep Then
        Call FillDataChecker(NextFormID - 1, False)
    End If
    Resume L_ExDataFormCompleted
End Function

Public Function DataSubFormCompleted(ByVal TargetTable As String, ByVal FieldCollection As String, ByVal AddNewRecord As Boolean, ByVal NextFormID As Integer, Optional ByVal IsLastStep As Boolean = False) As VbMsgBoxResult
'---------------------------------------------------------------------------
' Function      : DataSubFormCompleted
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Vérifie que les données du sous-formulaire sont complétées
'...........................................................................
' Parameters    : TargetTable : Table source
'                 FieldControlCollection : Liste des champs utilisés
'                 AddNewRecord : True si mode ajout
'                 NextFormID : ID du formulaire suivant

' Return Codes  : VbMsgBoxResult = Réponse au Msgbox
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Const ADD_MESSAGE                                      As String = "Avant d'ajouter un nouvel enregistrement, vous devez faire en sorte que l'enregistrement en cours soit complété."
Const ERR_MESSAGE                                      As String = "Avant de changer d'écran, vous devez faire en sorte que : " & vbCrLf & " - que l'enregistrement en cours soit complété." & vbCrLf & " - le formulaire possède au moins un enregistrement."
Const IGNORE_MESSAGE                                   As String = vbCrLf & vbCrLf & "Voulez-vous ignorer ce message et continuer ?"
Dim strMessage                                         As String
Dim blnAddNew                                          As Boolean

    On Error GoTo L_ErrDataSubFormCompleted
    'On affecte le bon message selon le mode
    If AddNewRecord Then
        strMessage = ADD_MESSAGE & IGNORE_MESSAGE
    Else
        strMessage = ERR_MESSAGE & IGNORE_MESSAGE
    End If
    'On appelle la fonction de vérification des données dans la table
    If VerifyFormDataTable(TargetTable, FieldCollection) = False Then
        Err.Raise 94, "Données requises", strMessage
    Else
        'On enrichit le tableau récapitulatif de vérification
        If IsLastStep Then
            'Si c'est la dernière, on prend l'index de la constante
            Call FillDataChecker(MAX_STEP_WIZ, True)
        Else
            'Celle en cours
            Call FillDataChecker(NextFormID - 1, True)
        End If
    End If
    On Error GoTo 0
L_ExDataSubFormCompleted:
    Exit Function

L_ErrDataSubFormCompleted:
    'En cas d'erreur (optimiste, on vérifie les data), la fonction retourne un MsgBox
    DataSubFormCompleted = MsgBox(Err.Description, vbExclamation + vbYesNo, Err.Source)
    'On décrémente le tableau récapitulatif de vérification pour cette étape
    If NextFormID <> LAST_FORM_INDEX Then
        Call FillDataChecker(NextFormID - 1, False)
    End If
    Resume L_ExDataSubFormCompleted
End Function

Private Function VerifyFormDataTable(ByVal TargetTable As String, ByVal FieldCollection As String) As Boolean
'---------------------------------------------------------------------------
' Function      : VerifyFormDataTable
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Contrôle champ par champ la nullité du contenu
'...........................................................................
' Parameters    : TargetTable : Table ou requête source
'                 FieldCollection : Champs de la source

' Return Codes  : Boolean = True if success
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Dim SQLSelect                                          As String
Dim oRS                                                As DAO.Recordset
Dim straFields()                                       As String
Dim strFieldName                                       As String
Dim vntValue                                           As Variant
Dim F                                                  As Integer
Dim lngNBRecords                                       As Long
Dim lngRowCount                                        As Long
Dim blnDataMissing                                     As Boolean

    On Error GoTo L_ErrVerifyFormDataTable
    blnDataMissing = False
    'Clause SQL sélectionnant tous les enregistrements de la table
    SQLSelect = "SELECT * FROM " & TargetTable & ";"
    'Ouverture du Recordset
    Set oRS = CurrentDb.OpenRecordset(SQLSelect, 2)
    'Affectation du tableau de champs
    straFields = Split(FieldCollection, ";")
    With oRS
        If Not .EOF Then
            .MoveLast
            'On compte le nombre d'enregistrements
            lngNBRecords = .RecordCount
            .MoveFirst
            Do While Not .EOF
                lngRowCount = lngRowCount + 1
                'Pour chacun des champs
                For F = LBound(straFields) To UBound(straFields)
                    'On attribue son nom à la variable
                    strFieldName = straFields(F)
                    'On verifie s'il est null
                    If IsNull(.Fields(strFieldName)) Then
                        'Auquel cas, on sort en attribuant True à la variable
                        blnDataMissing = True
                        Exit For
                    End If
                Next
                'À partir du moment où la variable est True, il est inutile de continuer, il y a une omission.
                If blnDataMissing Then
                    Exit Do
                End If
                .MoveNext
            Loop
        Else
            'S'il n'y a aucun enregistrement
            Err.Raise 3021
        End If
         'On ferme le Recordset
        .Close
    End With
    'La fonction retourne la négation logique de la valeur de la variable
    VerifyFormDataTable = Not blnDataMissing
    On Error GoTo 0
L_ExVerifyFormDataTable:
    'On libère l'objet
    Set oRS = Nothing
    Exit Function

L_ErrVerifyFormDataTable:
    VerifyFormDataTable = False
    Resume L_ExVerifyFormDataTable
End Function

Public Sub AddNewOrCancel(ByRef TargetForm As Form, ByVal SubFormIndex As Integer, ByVal TableSource As String, ByVal FieldCollection As String, ByVal FirstControl As String, ByVal SharedForeignIdentity As Boolean, ByVal NextFormID As Integer, Optional ByVal IsLastStep As Boolean = False)
'---------------------------------------------------------------------------
' Sub       : AddNewOrCancel
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Double procédure permettant d'ajouter un nouvel enregistrement ou d'annuler celui en cours de saisie
'...........................................................................
' Parameters    : TargetForm : Formulaire cible
'                 SubFormIndex : Si <> 0 signifie qu'il y a un sous-formulaire
'                 TableSource : Table ou requête source
'                 FieldCollection : Liste des champs de la source
'                 FirstControl : Nom du 1er contrôle
'                 SharedForeignIdentity : True si la source contient une valeur primaire commune (ici NoSite)
'                 NextFormID = ID du formulaire suivant

' Return Codes  :  None
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Dim oSubForm                                           As Form
    With TargetForm
        'Si la légende est {Annuler}
        Select Case .cmdAdd.Caption
            Case CMD_CANCEL
                'On demande confirmation de l'annulation
                If MsgBox("Voulez-vous annuler l'ajout en cours ?", vbQuestion + vbYesNo, "Annuler") = vbYes Then
                    'On pose une gestion d'erreurs optimiste
                    On Error Resume Next
                    'On appelle la méthode RunCommand de la constante AcCommand permettant l'annulation en cours
                    DoCmd.RunCommand acCmdUndo
                    'On réinitialise le gestionnaire d'erreurs
                    On Error GoTo 0
                    'On change l'intitulé des boutons
                    .cmdAdd.Caption = CMD_ADD
                    .cmdDelete.Caption = CMD_DELETE
                End If
                'Si la légende est {Ajouter}
            Case CMD_ADD
                'On met à jour les données sous-jacentes du formulaire en actualisant les modifications apportées aux enregistrements
                TargetForm.Requery
                'S'il y existe un index, on affecte l'objet oSubForm au sous-formulaire
                '(SubFormIndex=0 s'il n'y a pas de sous-formulaire)
                If SubFormIndex Then
                    'On affecte l'objet à ce sous-formulaire
                    Set oSubForm = Forms(FORM_DATA_WIZ & SubFormIndex)
                    With oSubForm
                        'On donne le focus au sous-formulaire
                        .SetFocus
                        On Error Resume Next
                        DoCmd.GoToRecord , , acNewRec
                        'Si la table contient le N° du site...
                        If SharedForeignIdentity Then
                            'On affecte au champ (ici : [NoSite]), la valeur de la variable publique
                            'qui contient sa valeur en cours.
                            .Form.NoSite = g_strNoSiteEnCours
                        End If
                        'On donne le focus au premier contrôle disponible
                        .Form.Controls(FirstControl).SetFocus
                        'On réinitialise le gestionnaire d'erreurs
                        On Error GoTo 0
                    End With
                Else
                    'On appelle la fonction interne DataFormCompleted() afin de vérifier si l'ajout est possible
                    If DataFormCompleted(TargetForm, False, FieldCollection, NextFormID, IsLastStep) = vbNo Then Exit Sub
                End If
                'On change l'intitulé des boutons
                .cmdAdd.Caption = CMD_CANCEL
                .cmdDelete.Caption = CMD_SAVE
        End Select
    End With
    'On libère l'objet...
    Set oSubForm = Nothing
End Sub

Public Sub DeleteOrSaveRecord(ByRef TargetForm As Form, ByVal SubFormIndex As Integer, ByVal TargetIDValue As Variant, ByVal DeleteClause As String, ByVal Subject As String)
'---------------------------------------------------------------------------
' Sub       : DeleteOrSaveRecord
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Double procédure permettant d'effacer un enregistrement ou de le sauvegarder
'...........................................................................
' Parameters    : TargetForm : Formulaire cible
'                 SubFormIndex : Si <> 0, on agit sur le sous-formulaire
'                 TargetIDValue : Valeur de l'identifiant
'                 DeleteClause : Clause SQL DELETE FROM
'                 Subject : Sujet de l'élément à supprimer

' Return Codes  :  = True if success
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Dim oSubForm                                           As Form

    On Error GoTo L_ErrDeleteOrSaveRecord

    'S'il y existe un index (SubFormIndex=0 s'il n'y a pas de sous-formulaire)
    If SubFormIndex Then
        'On affecte l'objet à ce sous-formulaire
        Set oSubForm = TargetForm.Form(FORM_DATA_WIZ & SubFormIndex)
    End If

    Select Case TargetForm.cmdDelete.Caption
            'Si la légende est {Supprimer}
        Case CMD_DELETE
            'Et si l'identifiant n'est pas nul
            If Not IsNull(TargetIDValue) Then
                'On confirme la suppression
                If MsgBox("Êtes-vous certain de vouloir supprimer " & Subject & " ?" & vbCrLf & vbCrLf & "Cette action est irréversible.", 292, "Supprimer un employé") = 6 Then
                    'On exécute la requête DELETE
                    CurrentDb.Execute DeleteClause, dbFailOnError
                    'Si c'est le sous-formulaire
                    If SubFormIndex Then
                        oSubForm.Requery
                    Else
                        TargetForm.Requery
                    End If
                End If
            Else
                'Si l'identifiant est nul, on lève une erreur
                Err.Raise 94, "Pas d'identifiant", "Il n'y a aucun enregistrement sélectionné qui puisse être supprimé !"
            End If
            'On change l'intitulé des boutons
            TargetForm.cmdDelete.Caption = CMD_DELETE
            TargetForm.cmdAdd.Caption = CMD_SAVE

            'Si la légende est {Sauvegarder}
        Case CMD_SAVE
            'Si c'est le sous-formulaire
            If SubFormIndex Then
                oSubForm.Requery
            Else
                TargetForm.Requery
            End If
            'On change l'intitulé des boutons
            TargetForm.cmdAdd.Caption = CMD_ADD
            TargetForm.cmdDelete.Caption = CMD_DELETE
    End Select
    On Error GoTo 0
L_ExDeleteOrSaveRecord:
    'On libère l'objet...
    Set oSubForm = Nothing
    Exit Sub

L_ErrDeleteOrSaveRecord:
    MsgBox Err.Description, vbExclamation, Err.Source
    Resume L_ExDeleteOrSaveRecord
End Sub

Private Function DataTableHasRecord(ByVal SQLQuery As String) As Boolean
'---------------------------------------------------------------------------
' Function      : DataTableHasRecord
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Vérifie que la source SQLQuery possède des enregistrements
'...........................................................................
' Parameters    : SQLQuery :

' Return Codes  : Boolean = True if has data
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Dim oRS                                                As DAO.Recordset
    'On initialise l'objet Recordset avec la chaîne SQL passée en paramètre
    Set oRS = CurrentDb.OpenRecordset(SQLQuery, 2)
    With oRS
        'On renvoie la valeur correspondant à la position d'enregistrement actuelle :
        'False = aucun enregistrement
        DataTableHasRecord = Not .EOF
        .Close
    End With
    Set oRS = Nothing
End Function

Public Function NullData(ByVal Ctl As Variant, ByVal DataType As Integer) As Integer
'---------------------------------------------------------------------------
' Function      : NullData
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Retourne 1 ou 0 selon la nullité du contenu
'...........................................................................
' Parameters    : Ctl : contrôle de formulaire cible
'                 DataType : Type de donnée du contrôle

' Return Codes  : Integer = True if success
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------

    On Error GoTo L_ErrNullData

    NullData = 0
    If Not IsNull(Ctl) Then
        NullData = 1
    End If
    Select Case DataType
        Case 10
            If Len(Nz(Ctl, "")) Then
                NullData = 1
            End If
        Case 4
            If (Ctl > 0) Then
                NullData = 1
            ElseIf (Ctl = 0) And (Len(Ctl) < 2) Then
                NullData = 0
            Else
                NullData = Nz(Ctl, 0)
            End If
        Case 8
            If IsDate(Ctl) Then
                NullData = 1
            End If
        Case Else
    End Select

    On Error GoTo 0
L_ExNullData:
    Exit Function

L_ErrNullData:
    NullData = 0
    Resume L_ExNullData
End Function

Public Function NotInList(ByVal NewData As String, ByVal ItemSubject As String) As Integer
'---------------------------------------------------------------------------
' Function      : NotInList
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Fonction générique de substitution de l'événement NotInList d'un ComboBox
'...........................................................................
' Parameters    : NewData : Valeur que l'utilisateur a entrée dans la zone de liste modifiable.
'                 ItemSubject : Sujet de la liste déroulante

' Return Codes  : Integer = Valeur la fonction NotInList
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
    MsgBox ItemSubject & " '" & NewData & "' ne fait pas partie de la liste !", vbExclamation, "Choix incorrect"
    NotInList = acDataErrContinue
End Function

'**********************************************************************
' Module            : basMain
' Type              : Module
' DateTime          : 30/07/2015
' Author            : Argyronet
' Review            : 23/09/2015 - Jean-Philippe AMBROSINO
' Review date       : 27/11/2015
' Purpose           : Tutoriel : Réalisez un assistant de présaisie des données pour alimenter la base d'un serveur central
'
'**********************************************************************
Option Compare Database
Option Explicit

'Affichage ou masquage des contrôles : Prod = False ; Test = True
Public Const SHOW_HIDDEN_CONTROLS                      As Boolean = False
'Constantes de données
Public Const MAX_STEP_WIZ                              As Integer = 5
Public Const LAST_FORM_INDEX                           As Integer = 99
'Constantes des noms de formulaire
Public Const FORM_DATA_WIZ                             As String = "frmDataWizard"
Public Const SUBFORM_DATA_WIZ                          As String = "sfrmDataWizard"
Public Const SUB_FORM_SUFFIX                           As String = "_sub"
Public Const FORM_START                                As String = "frmStart"
Public Const FORM_END                                  As String = "frmEnd"
'Constantes des boutons de commandes
Public Const CMD_STOP                                  As String = "&Arrêter"
Public Const CMD_CLOSE                                 As String = "&Fermer"
Public Const CMD_ADD                                   As String = "Aj&outer"
Public Const CMD_SAVE                                  As String = "S&auvegarder"
Public Const CMD_VALIDATE                              As String = "V&alider"
Public Const CMD_MODIFY                                As String = "M&odifier"
Public Const CMD_CANCEL                                As String = "&Annuler"
Public Const CMD_DELETE                                As String = "S&upprimer"
Public Const CMD_CANCEL_3DOTS                          As String = CMD_CANCEL & "..."
Public Const CMD_RESTART                               As String = "&Recommencer..."

Public Const CLR_REDCOLOR                              As Long = 255
Public Const CLR_GREENCOLOR                            As Long = 39168

'Énumération qui définit le sens d'ouverture des formulaires
Public Enum ge_FormDirection
    GotoNext = 1
    GotoPrevious = 3
End Enum


'Variables publiques :
'No du site et nom du domaine exploités par la session en cours
Public g_strNoSiteEnCours                              As String
Public g_strDomaineSiteEnCours                         As String
'Liste des étapes incomplètes
Public g_strDataSteps                                   As String
'Tableau des N° d'étapes complétées ou non
Public g_intCompletionIndex(1 To MAX_STEP_WIZ)         As Integer

Public Sub FillDataChecker(ByVal Index As Integer, ByVal Completed As Boolean)
'---------------------------------------------------------------------------
' Sub       : FillDataChecker
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Alimente le tableau g_intCompletionIndex selon l'index passé
'...........................................................................
' Parameters    : Index : Index du tableau
'                 Completed : True si complété

' Return Codes  :  None
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
    g_intCompletionIndex(Index) = Completed
End Sub

Public Function AllStepsAreCompleted(ByRef Count As Integer) As Boolean
'---------------------------------------------------------------------------
' Function      : AllStepsAreCompleted
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Vérifie les étapes complétées
'...........................................................................
' Parameters    : Count : Valeur représentant le nombre d'étapes

' Return Codes  : Boolean = True if success
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Dim P                                                  As Integer
Dim intStepCount                                       As Integer
Dim strDataPage                                        As String

    intStepCount = 0
    strDataPage = ""
    'Pour chacune des étapes
    For P = LBound(g_intCompletionIndex) To UBound(g_intCompletionIndex)
        'Si elle a été affectée à True via FillDataChecker()
        If (g_intCompletionIndex(P) = True) Then
            'On incrémente le nombre d'étapes valides
            intStepCount = intStepCount + 1
        Else
            'Sinon, on remplit une chaîne stipulant les étapes ignorées
            strDataPage = strDataPage & " - étape N° " & P & vbCrLf
        End If
    Next
    Count = intStepCount
    'La fonction est True si le nombre d'étapes complétées est égal au nombre total d'étapes
    AllStepsAreCompleted = (Count = MAX_STEP_WIZ)
    'Définit le message final
    If Len(strDataPage) Then
        g_strDataPage = "Liste des étapes incomplètes :" & vbCrLf & vbCrLf & strDataPage
    Else
        g_strDataPage = "Liste des étapes incomplètes :" & vbCrLf & vbCrLf & "Aucune"
    End If
End Function

Public Function EraseAllDataBefore(ByRef ErrDescription As String) As Boolean
'---------------------------------------------------------------------------
' Function      : EraseAllDataBefore
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Fonction de RAZ des données occultant certaines tables
'...........................................................................
' Parameters    : ErrDescription = Message d'erreur

' Return Codes  : Boolean = True if success
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Const TABLE_TO_IGNORE                                  As String = "tbl_ListeDepartements;tbl_ListeDesCommunes;tbl_ListeDesRegions;tbl_Privileges;tbl_TypesContrat"
Const CHAR_SEP                                         As String = ";"
Const DELETE_DATA                                      As String = "DELETE * FROM #T;"
Dim oDB                                                As DAO.Database
Dim strListOfTables                                    As String
Dim straTables()                                       As String
Dim SQLDelete                                          As String
Dim T                                                  As Integer
    On Error GoTo L_ErrEraseAllDataBefore
    strListOfTables = GetListOfTables(TABLE_TO_IGNORE, CHAR_SEP)
    Set oDB = CurrentDb
    With oDB
        Debug.Print strListOfTables
        straTables = Split(strListOfTables, CHAR_SEP)
        For T = LBound(straTables) To UBound(straTables)
            SQLDelete = Replace(DELETE_DATA, "#T", straTables(T))
            .Execute SQLDelete, dbFailOnError
        Next
        .Close
    End With
    EraseAllDataBefore = True
    On Error GoTo 0
L_ExEraseAllDataBefore:
    Set oDB = Nothing
    Exit Function

L_ErrEraseAllDataBefore:
    EraseAllDataBefore = False
    'Message d'erreur avec N°
    ErrDescription = Err.Description & " - (" & Err.Number & ")"
    Resume L_ExEraseAllDataBefore
End Function

Private Function GetListOfTables(ByVal ExcludeTables As String, Optional ByVal CharSep As String = ";") As String
'---------------------------------------------------------------------------
' Function      : GetListOfTables
' DateTime      : 27/11/2015
' Author        : Jean-Philippe AMBROSINO : Argyronet sur developpez.com (Code du tutoriel 11-2015)
' Purpose       : Retourne la liste des tables devant être vidées
'...........................................................................
' Parameters    : ExcludeTables : Liste des tables à exclure

' Return Codes  : String = Liste des tables
'...........................................................................
' Notice        :
'---------------------------------------------------------------------------
Dim oDB                                                As DAO.Database
Dim oTDF                                               As DAO.TableDef
Dim strDataTables                                      As String
Dim straExcludeTables()                                As String
Dim strExcludeTable                                    As String
Dim T                                                  As Integer
    Set oDB = CurrentDb
    straExcludeTables = Split(ExcludeTables, CharSep)
    'Énumère toutes les tables sauf les tables système
    For Each oTDF In oDB.TableDefs
        With oTDF
            If .Attributes = 0 And Left$(.Name, 4) <> "MSys" Then
                'On incrémente la chaîne avec le nom des tables
                strDataTables = strDataTables & Trim$(.Name) & CharSep
            End If
        End With
    Next
    'On ferme la base instanciée
    oDB.Close
    Set oDB = Nothing
    'On parcourt le tableau des tables à exclure
    For T = LBound(straExcludeTables) To UBound(straExcludeTables)
        strExcludeTable = straExcludeTables(T)
        'On remplace chaque table à exclure et son ; par une chaîne vide
        strDataTables = Replace(strDataTables, strExcludeTable & CharSep, "")
    Next
    'On élimine le dernier caractère et on affecte le tout comme valeur de retour
    If Right(strDataTables, 1) = CharSep Then
        GetListOfTables = Left$(strDataTables, Len(strDataTables) - 1)
    End If
End Function