Un classeur Excel multi-utilisateur

Option Explicit

'------------------------------------------------------------------------------------------------------
' Code à placer dans la feuille active contenant les cellules concernées :
'------------------------------------------------------------------------------------------------------
'Private Sub Worksheet_Change(ByVal Target As Range)
'------------------------------------------------------------------------------------------------------
'Saisies_Excel_Enregistrer Target
'End Sub
'------------------------------------------------------------------------------------------------------

Public Saisie_Excel_Tracabilite As Boolean

'------------------------------------------------------------------------------------------------------
Public Sub Saisies_Excel_Enregistrer(Target As Range)
'------------------------------------------------------------------------------------------------------
Dim i As Long, C As Range
On Error Resume Next

' Début du traitement :
ADO.Cnn_Debut SansTransaction

' Boucle sur toutes les cellules de la sélection :
For Each C In Target

    ' Si le nom de la cellule commence par "ADO_" :
    i = 0: i = InStr(1, C.Name.Name, "!ADO_", vbTextCompare)
    If i > 0 Then

        ' Enregistre la formule mais aussi l'utilisateur et la date de mise à jour :
        ADO.Enr_MAJ Cnn1, "Saisies_Excel", "Nom = '" & C.Name.Name & "'", ModificationOuCréation, _
                    "Nom", C.Name.Name, _
                    "Formule", Range(C.Name).Formula, _
                    "Qui", Left(Application.UserName, 255), _
                    "Quand", Now

        ' Modifie le commentaire si le mode traçabilité est activé :
        If Saisie_Excel_Tracabilite = True Then
            If Range(C.Name).Comment Is Nothing = True Then Range(C.Name).AddComment ""
            Range(C.Name).Comment.Text Application.UserName & vbCrLf & Now
        End If

    End If

Next C

' Fin du traitement :
ADO.Cnn_Fin MessageSiErreur
Err.Clear
End Sub

'------------------------------------------------------------------------------------------------------
Public Sub Saisies_Excel_Importer()
'------------------------------------------------------------------------------------------------------
Dim Nom As Name
On Error Resume Next

' Début du traitement :
ADO.Cnn_Debut SansTransaction

' Bloque les évènements :
Application.Cursor = xlWait
Application.EnableEvents = False

' Boucle sur les cellules avec des noms :
For Each Nom In ThisWorkbook.Names

    ' Si le nom contient "!ADO_" alors le traiter :
    If InStr(1, Nom.Name, "!ADO_", vbTextCompare) > 0 Then

        ' Importation de la formule :
        Range(Nom.Name).Formula = _
            ADO.Enr_Info(Cnn1, "Saisies_Excel", "Nom = '" & Nom.Name & "'", valeur, "Formule")

        ' Si le mode traçabilité est activé :
        If Saisie_Excel_Tracabilite = True Then
            If Range(Nom.Name).Comment Is Nothing = True Then Range(Nom.Name).AddComment ""
            Range(Nom.Name).Comment.Text _
                ADO.Enr_Info(Cnn1, "Saisies_Excel", "Nom = '" & Nom.Name & "'", valeur, "Qui") & vbCrLf _
              & ADO.Enr_Info(Cnn1, "Saisies_Excel", "Nom = '" & Nom.Name & "'", valeur, "Quand")
            Application.DisplayNoteIndicator = True ' Affiche les indicateurs d'annotations.
            Application.DisplayCommentIndicator = xlCommentIndicatorOnly ' Quand la souris est sur la cellule
        End If

    End If

Next Nom
Application.Cursor = xlDefault

' Fin du traitement :
ADO.Cnn_Fin MessageSiErreur
Application.EnableEvents = True
Err.Clear
End Sub

'------------------------------------------------------------------------------------------------------
Public Sub Saisies_Excel_Nom_Ajouter()
'------------------------------------------------------------------------------------------------------
Dim i As Long, C As Range
Dim Nom As Name, Nb As Integer, Num As Long
On Error Resume Next

If Selection.Count > 10000 Then
    MsgBox "Vous ne pouvez pas nommer plus de 10 000 cellules à la fois", vbCritical
    Exit Sub
End If

' Boucle sur toutes les cellules de la sélection :
For Each C In Selection

    ' Analyse si la cellule a un nom :
    Nb = Nb + 1
    Application.StatusBar = "Analyse cellule " & Nb & " sur " & Selection.Count
    i = 0: i = Len(C.Name.Name)

    ' Si la cellule n'a pas de nom :
    If i = 0 Then

        ' Recherche le prochain numéro disponible :
        Do
            Num = Num + 1
            i = 0
            i = Len(Range("ADO_" & Format(Num, "00000")).Address)
            DoEvents
        Loop While i > 0

        ' Si la valeur ne dépasse pas 99999 alors création du nom :
        If Num <= 99999 Then
            ActiveWorkbook.ActiveSheet.Names.Add Name:="ADO_" & Format(Num, "00000"), _
                                                 RefersTo:="=" & ActiveSheet.Name & "!" & C.Address
        End If

    End If

Next C
Application.StatusBar = ""
Err.Clear
End Sub

'------------------------------------------------------------------------------------------------------
Public Sub Saisies_Excel_Nom_Supprimer()
'------------------------------------------------------------------------------------------------------
Dim i As Long, C As Range, Nb As Integer
On Error Resume Next

If Selection.Count > 10000 Then
    MsgBox "Vous ne pouvez pas sélectionner plus de 10 000 cellules à la fois", vbCritical
    Exit Sub
End If

' Boucle sur toutes les cellules de la sélection :
For Each C In Selection

    Nb = Nb + 1
    Application.StatusBar = "Analyse cellule " & Nb & " sur " & Selection.Count

    ' Si la cellule a un nom alors le supprimer :
    ActiveWorkbook.Names(C.Name.Name).Delete
    DoEvents

Next C
Application.StatusBar = ""
Err.Clear
End Sub
'------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------

Option Explicit

'------------------------------------------------------------------------------------------------
Public Sub ClearTD(ByRef TD As Range)
'------------------------------------------------------------------------------------------------
' Efface le Tableau de Données et le redimensionne
'------------------------------------------------------------------------------------------------
On Error Resume Next

TD.ListObject.DataBodyRange.ClearContents ' Efface le contenu du Tableau de Données.
ResizeTD TD                               ' Redimensionne le Tableau de Données.

Err.Clear
End Sub

'------------------------------------------------------------------------------------------------
Public Function ResizeTD(ByRef TD As Range) As Long
'------------------------------------------------------------------------------------------------
' Redimensionne le Tableau de données (coupe le tableau à la première ligne vide rencontrée
' (sauf la première) ou l'étend à la dernière rencontrée).
' Retourne le nombre de lignes ou 0 si le tableau est vierge, ou -9 si erreur.
'------------------------------------------------------------------------------------------------
Dim TDName As String, SheetName As String, i As Long

' Gestion des erreurs :
Err.Clear: On Error GoTo Gest_Err

TDName = TD.ListObject.Name                          ' Mémorise le lien sur le TD.
SheetName = TD.ListObject.Parent.Name                ' Mémorise la feuille du TD.
TD.ListObject.Resize Range(TD.CurrentRegion.Address) ' Redimensionne le TD.

' Ajoute une nouvelle ligne si le tableau de données est vierge :
If TD.ListObject.ListRows.Count = 0 Then
    TD.ListObject.ListRows.Add 1
    ResizeTD = 0
Else
    ResizeTD = TD.ListObject.ListRows.Count ' Retourne le nombre de lignes.
End If

' Cas particulier s'il y a 1 ligne. Vérifier si elle est vide ou non :
If ResizeTD = 1 Then
    ResizeTD = 0
    For i = 1 To TD.Columns.Count
        If TD(1, i) <> "" Then ResizeTD = 1: Exit For
    Next i
End If ' Retourne 0 si la ligne est vierge ou 1 si la ligne est active.

Set TD = ThisWorkbook.Sheets(SheetName).Range(TDName) ' Restaure le lien sur le tableau de données.

' Fin du traitement :
Gest_Err:
If Err.Number <> 0 Then ResizeTD = -9
Err.Clear

End Function
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------
' Module utilisé pour la gestion des appels aux bases ACCESS (lectures et écritures) avec la
' méthode ADODB qui prend en charge les transactions.
'-----------------------------------------------------------------------------------------------
' Nécessite d'installer la référence : Microsoft ActiveX Data Objects 6.1 Library
'-----------------------------------------------------------------------------------------------

Option Explicit

'-----------------------------------------------------------------------------------------------
Private Const Provider_ACCDB As String = "Microsoft.ACE.OLEDB.12.0"
Private Const Provider_MDB As String = "Microsoft.Jet.OLEDB.4.0"
'-----------------------------------------------------------------------------------------------
Public Provider_MotDePasse As String ' Contiendra l'éventuel mot de passe des bases,
' voir : https://www.developpez.net/forums/d2008001/logiciels/microsoft-office/access/vba-access/ouvrir-fichier-accdb-protege-passe-ado/#post11149077
'-----------------------------------------------------------------------------------------------
Public Cnn1 As ADODB.Connection ' 1ere Base.
Public Cnn2 As ADODB.Connection ' 2eme Base.
Public Cnn3 As ADODB.Connection ' 3eme Base.
Public Cnn4 As ADODB.Connection ' 4eme Base.
Public Cnn5 As ADODB.Connection ' 5eme Base.
Public Cnn6 As ADODB.Connection ' 6eme Base.
Public Cnn7 As ADODB.Connection ' 7eme Base.
Public Cnn8 As ADODB.Connection ' 8eme Base.
Public Cnn9 As ADODB.Connection ' 9eme Base.
'-----------------------------------------------------------------------------------------------
Private Cnn_Etat_Transaction As EnumEtatTransaction ' Etat de la transaction.
'-----------------------------------------------------------------------------------------------
Private Enum EnumEtatTransaction
    Transaction_Null = 0
    Transaction_OK = 1
    Transaction_KO = 2
End Enum
'-----------------------------------------------------------------------------------------------
Public Enum EnumActionMAJ
    ModificationUniquement = 0
    ModificationOuCréation = 1
    Suppression = 2
    CréationUniquement = 3
End Enum
'-----------------------------------------------------------------------------------------------
Public Enum EnumActionCopier
    RemplacerUniquement = 0
    RemplacerOuCréer = 1
    ForcerCréation = 2
End Enum
'-----------------------------------------------------------------------------------------------
Public Enum EnumActionSiErreur
    IgnorerErreur = 0
    MémoriserErreur = 1
End Enum
'-----------------------------------------------------------------------------------------------
Public Enum EnumActionTransaction
    SansTransaction = 0
    AvecTransaction = 1
End Enum
'-----------------------------------------------------------------------------------------------
Public Enum EnumMessage
    SansMessage = 0
    MessageSiErreur = 1
    AvecMessage = 2
End Enum
'-----------------------------------------------------------------------------------------------
Private Enum EnumVerrou
    LectureSeule = 0
    LectureEcriture = 1
End Enum
'-----------------------------------------------------------------------------------------------
Public Enum EnumInfoEnr
    valeur = 0
    Compte = 1
    Somme = 2
    Moyenne = 3
    Mini = 4
    Maxi = 5
    NbChamps = 6
End Enum
'-----------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------
' Gestion des erreurs :
'-----------------------------------------------------------------------------------------------
Private ADO_Err_Number As Long
Private ADO_Err_Description As String
Private ADO_Err_Source As String
Private ADO_Err_Fonction As String
Private ADO_Err_Instruction As String
'-----------------------------------------------------------------------------------------------

'-----------------------------------------------------------------------------------------------
Function Cnn_Initialise(Cnn As ADODB.Connection, StrBaseSource As String) As Boolean
'-----------------------------------------------------------------------------------------------
' Ouvre une connexion avec la méthode ADO sur une base ACCESS.
' Cnn = Connexion concernée (entre 1 et 9).
' StrBaseSource = Base concernée (chemin complet + nom avec l'extension).
' Retourne : VRAI si connexion réussie ou FAUX si erreur.
'-----------------------------------------------------------------------------------------------
OuvrirConnexion:
Err.Clear
On Error GoTo Gest_Err

' Si le chemin StrBaseSource n'est pas valide alors force une erreur personnalisée :
If Dir(StrBaseSource) = "" Then
    Err.Raise vbObjectError + 513, "Cnn_Initialise", "La base """ & StrBaseSource & """ n'a pas été trouvée."
End If

' Paramètres de connexion :
Set Cnn = New ADODB.Connection
Cnn.CommandTimeout = 30
Cnn.CursorLocation = adUseServer
Application.StatusBar = "Demande de connexion...": DoEvents

' Détermine le fournisseur pour les bases .accdb, ou .mdb:
Select Case UCase(Mid(StrBaseSource, InStrRev(StrBaseSource, ".")))

    Case Is = ".ACCDB"

        If Provider_MotDePasse = "" Then ' Sans mot de passe :
            Cnn.Open "Provider= " & Provider_ACCDB & ";" _
                    & "Data Source=" & StrBaseSource & ";" _
                    , "Admin", "", adAsyncConnect

        Else ' Avec mot de passe (<2010 ou "Paramètres du client/Avancé/Utiliser le chiffrement hérité)
            Cnn.Open "Provider= " & Provider_ACCDB & ";" _
                    & "Data Source=" & StrBaseSource & ";" _
                    & "Jet OLEDB:Database Password=" & Provider_MotDePasse & ";"
        End If

    Case Is = ".MDB"

        Cnn.Open "Provider= " & Provider_MDB & ";" _
                & "Data Source=" & StrBaseSource _
                & ";", "Admin", "", adAsyncConnect

End Select

' Vérifie la connexion :
While (Cnn.State = adStateConnecting): DoEvents: Wend

' Retourne VRAI si tout va bien (ou FAUX si une Erreur est détectée) :
On Error Resume Next
If Cnn.State = adStateOpen Then
    Cnn_Initialise = True ' Connexion Ok
End If

Gest_Err:

' Si base de donnée avec mot de passe :
If Err.Number = -2147217843 Then
     Provider_MotDePasse = InputBox("Saisir le mot de passe : ", "La base est protégée par un mot de passe")
     If Provider_MotDePasse <> "" Then
        Set Cnn = Nothing
        GoTo OuvrirConnexion
     End If
End If

' Si le traitement a généré une erreur elle est mémorisée :
MémoriserErreurBase "Cnn_Initialise", StrBaseSource

' Désactiver la connexion :
If Cnn Is Nothing = False Then
    ' S'il n'y a pas de transaction en cours alors ferme la connexion Cnnx:
    If Cnn_Etat_Transaction = Transaction_Null Then
        If Cnn.State = adStateOpen Then Cnn.Close
    End If
End If

Application.StatusBar = ""
Provider_MotDePasse = ""
Err.Clear
End Function

'-----------------------------------------------------------------------------------------------
Private Sub Fermer_Toutes_Les_Connexions()
'-----------------------------------------------------------------------------------------------
' Ferme toutes les connexions existantes.
'-----------------------------------------------------------------------------------------------
Fermer_Connexion Cnn1
Fermer_Connexion Cnn2
Fermer_Connexion Cnn3
Fermer_Connexion Cnn4
Fermer_Connexion Cnn5
Fermer_Connexion Cnn6
Fermer_Connexion Cnn7
Fermer_Connexion Cnn8
Fermer_Connexion Cnn9
End Sub

'-----------------------------------------------------------------------------------------------
Private Sub Fermer_Connexion(Cnn As ADODB.Connection)
'-----------------------------------------------------------------------------------------------
' Permet de désactiver la connexion avec une base.
' Remarque : Si une transaction est en cours, la désactivation à la base n'est pas possible.
' Remarque : La désactivation par la méthode .Close ne détruit pas la connexion existante qui peut
' être (ré)activée avec un simple appel par la méthode .Open, sans argument à passer.
' La désactivation est transparente pour le programmeur car elle est gérée par les fonctions du module ADO.
'-----------------------------------------------------------------------------------------------
' Gestion des erreurs :
Err.Clear
On Error GoTo Gest_Err

If Cnn Is Nothing = False Then

    ' S'il n'y a pas de transaction en cours alors ferme la connexion Cnnx :
    If Cnn_Etat_Transaction = Transaction_Null Then
        If Cnn.State = adStateOpen Then Cnn.Close
    End If

End If

Gest_Err:

' Si le traitement a généré une erreur elle est mémorisée :
MémoriserErreurBase "Fermer_Connexion", ""

End Sub

'-----------------------------------------------------------------------------------------------
Private Sub Ouvrir_Toutes_Les_Transactions()
'-----------------------------------------------------------------------------------------------
' Ouvre une transaction sur toutes les connexions existantes.
'-----------------------------------------------------------------------------------------------
' Par défaut :
Cnn_Etat_Transaction = Transaction_Null

' Ouvre toutes les connexions possibles :
If Cnn1 Is Nothing = False Then Ouvrir_Transaction Cnn1
If Cnn2 Is Nothing = False Then Ouvrir_Transaction Cnn2
If Cnn3 Is Nothing = False Then Ouvrir_Transaction Cnn3
If Cnn4 Is Nothing = False Then Ouvrir_Transaction Cnn4
If Cnn5 Is Nothing = False Then Ouvrir_Transaction Cnn5
If Cnn6 Is Nothing = False Then Ouvrir_Transaction Cnn6
If Cnn7 Is Nothing = False Then Ouvrir_Transaction Cnn7
If Cnn8 Is Nothing = False Then Ouvrir_Transaction Cnn8
If Cnn9 Is Nothing = False Then Ouvrir_Transaction Cnn9
End Sub

'-----------------------------------------------------------------------------------------------
Private Function Ouvrir_Transaction(Cnn As ADODB.Connection) As Boolean
'-----------------------------------------------------------------------------------------------
' Débute la transaction de la connexion Cnn avec la méthode ADO.
' Renseigne Cnn_Transaction_OK = VRAI par défaut. Passera par la suite à FAUX si un problème
' est rencontré dans un traitement de mise à jour des tables (yc par SQL).
' Retourne : VRAI si tout va bien, FAUX en cas d'Erreur.
'-----------------------------------------------------------------------------------------------
' Gestion des erreurs :
Err.Clear
On Error GoTo Gest_Err

' Attente que la connexion soit établie :
If Cnn.State = adStateClosed Then Cnn.Open
If Cnn.State >= adStateConnecting Then
    Application.StatusBar = "Attente de libération de la base..."
    While (Cnn.State = adStateConnecting): DoEvents: Wend
    Application.StatusBar = ""
End If

' Lance la transaction de Cnn :
Cnn.BeginTrans

' Déclare la transaction active :
Cnn_Etat_Transaction = Transaction_OK

Gest_Err:

' Si le traitement a généré une erreur elle est mémorisée et retourne FAUX :
Ouvrir_Transaction = MémoriserErreurBase("Ouvrir_Transaction", "")

Application.StatusBar = ""
Err.Clear

End Function

'-----------------------------------------------------------------------------------------------
Private Function Fin_Des_Transactions() As Long
 '-----------------------------------------------------------------------------------------------
' Ferme toutes les transactions en cours.
' Et en utilisant la variable Cnn_Etat_Transaction pour savoir si les différents
' traitements ont bien été réalisées et si Cnn.State = 1
' Attention : Ne pas fermer les connexions avant de fermer les transactions.
' Retourne : Cnn_Etat_Transaction (Transaction_OK si tout va bien).
' Remarque : La fin des transactions ne ferme pas les connexions.
'-----------------------------------------------------------------------------------------------
' Gestion des erreurs :
On Error Resume Next

Application.StatusBar = "Validation des transactions..."

' Si tout va bien alors réalise la transaction sinon annule la transaction :
If Cnn1 Is Nothing = False Then Fin_Transaction Cnn1
If Cnn2 Is Nothing = False Then Fin_Transaction Cnn2
If Cnn3 Is Nothing = False Then Fin_Transaction Cnn3
If Cnn4 Is Nothing = False Then Fin_Transaction Cnn4
If Cnn5 Is Nothing = False Then Fin_Transaction Cnn5
If Cnn6 Is Nothing = False Then Fin_Transaction Cnn6
If Cnn7 Is Nothing = False Then Fin_Transaction Cnn7
If Cnn8 Is Nothing = False Then Fin_Transaction Cnn8
If Cnn9 Is Nothing = False Then Fin_Transaction Cnn9

' Retourne l'état OK ou KO des transactions :
Fin_Des_Transactions = Cnn_Etat_Transaction

' Indique qu'il n'y a plus de transaction en cours :
Cnn_Etat_Transaction = Transaction_Null

Application.StatusBar = ""
Err.Clear
End Function

'-----------------------------------------------------------------------------------------------
Private Sub Fin_Transaction(Cnn As ADODB.Connection)
 '-----------------------------------------------------------------------------------------------
' Ferme la transaction Cnn avec la méthode ADO.
' Cnn = Connexion à utiliser.
'-----------------------------------------------------------------------------------------------
' Gestion des erreurs :
On Error GoTo Gest_Err

' Attente que la connexion soit établie :
While (Cnn.State = adStateConnecting): DoEvents: Wend

' Si tout va bien alors réalise la transaction sinon annule la transaction :
If Cnn_Etat_Transaction = Transaction_OK And Cnn.State = adStateOpen Then
    Cnn.CommitTrans
Else
    Cnn.RollbackTrans
End If

Gest_Err:
Err.Clear
End Sub

'-----------------------------------------------------------------------------------------------
Private Sub Fermer_Recordset(ByRef MonRs As ADODB.Recordset)
'-----------------------------------------------------------------------------------------------
' Fermeture du recordset MonRs en ne générant pas d'erreur s'il est déjà fermé.
'-----------------------------------------------------------------------------------------------
On Error Resume Next
If MonRs Is Nothing = False Then
    MonRs.Close
    Set MonRs = Nothing
End If

Err.Clear
End Sub

'-----------------------------------------------------------------------------------------------
Function Enr_Info(Cnn As ADODB.Connection, StrTableSource As String, _
                  ByVal SQLWhere As String, _
                  TypeInfoEnr As EnumInfoEnr, _
                  ByVal StrNomChamp As String) As Variant
'-----------------------------------------------------------------------------------------------
' Fait une fonction d’agrégation sur un champ d'une table avec une requête SQL.
' Cnn = La connexion à utiliser.
' StrTableSource = Table concernée.
' SQLWhere = Requête d'instruction permettant d'identifier la sélection (sans le mot clé WHERE).
'            Si SQLWhere vaut "" alors toute la table est sélectionnée.
' TypeInfoEnr = l'une des énumérations suivantes :
'               Valeur = Retourne la valeur du champ désiré (le 1er enregistrement trouvé).
'               Compte = Compte le nombre d'enregistrement (COUNT)
'               Somme = Fait la somme des enregistrements (SUM)
'               Moyenne = Calcule la moyenne des enregistrements (AVG)
'               Mini = Retourne le plus petit enregistrement (MIN)
'               Maxi = Retourne le plus grand enregistrement (MAX)
'               NbChamps = Retourne le nombre de champs dans le jeu d'enregistrement.
' StrNomChamp = Nom du champ.
' Retourne : Le résultat trouvé.
' Retourne : Vide si aucun enregistrement n'est sélectionné ou en cas d'erreur.
'-----------------------------------------------------------------------------------------------
Dim MonRs As ADODB.Recordset
Dim TypeOpé As Variant
TypeOpé = Array("", "COUNT", "SUM", "AVG", "MIN", "MAX", "")

' Gestion des erreurs :
Err.Clear
On Error GoTo Gest_Err

' Attente que la connexion soit établie :
If Cnn.State = adStateClosed Then Cnn.Open
If Cnn.State >= adStateConnecting Then
    Application.StatusBar = "Attente de libération de la base..."
    While (Cnn.State = adStateConnecting): DoEvents: Wend
    Application.StatusBar = ""
End If

If StrTableSource <> "" Then

    ' Supprime les éventuels crochets sur le nom de la table source :
    StrTableSource = Replace(StrTableSource, "[", "")
    StrTableSource = Replace(StrTableSource, "]", "")

    ' Supprime les éventuels crochets sur le nom du champ :
    StrNomChamp = Replace(StrNomChamp, "[", "")
    StrNomChamp = Replace(StrNomChamp, "]", "")

    ' Définition de la requête complète :
    SQLWhere = "SELECT " & TypeOpé(TypeInfoEnr) & " (" & StrNomChamp & ") FROM [" & StrTableSource & "] " & IIf(SQLWhere > "", "WHERE " & SQLWhere, "")
    SQLWhere = Replace(SQLWhere, "([*])", "(*)")
    SQLWhere = Replace(SQLWhere, "SELECT  (*)", "SELECT *")
    SQLWhere = Replace(SQLWhere, "COUNT ()", "COUNT (*)")

End If

' Ouverture de la table en lecture seule :
Set MonRs = New ADODB.Recordset
MonRs.Open SQLWhere, Cnn, adOpenStatic, adLockReadOnly, adCmdText

' Si un résultat existe :
If MonRs.EOF = False Then Enr_Info = MonRs.Fields(0)

' S'il faut retourner le nombre de champs :
If TypeInfoEnr = NbChamps Then Enr_Info = MonRs.Fields.Count

Gest_Err:

' Si le traitement a généré une erreur elle est mémorisée :
MémoriserErreurBase "Enr_Info", SQLWhere

' Désactiver la connexion :
Fermer_Recordset MonRs
Fermer_Connexion Cnn

Application.StatusBar = ""
Err.Clear
End Function

'-----------------------------------------------------------------------------------------------
Function Enr_Affiche(Cnn As ADODB.Connection, StrTableSource As String, _
                     ByVal SQLWhere As String, _
                     RngDest As Range) As Boolean
'-----------------------------------------------------------------------------------------------
' Affiche un jeu d'enregistrements à partir de la cellule haut gauche de destination.
' Cnn = La connexion à utiliser.
' StrTableSource = Table concernée (ou une requête dans la base).
'                  Ne pas mettre la table entre crochets "[" et "]" car ils sont automatiquement ajoutés.
'                  Si vide alors l'instruction dans SQLWhere sera utilisée comme requête pour ouvrir la source.
' SQLWhere = Requête d'instruction permettant de sélectionner les enregistrements (sans le mot clé WHERE).
' RngDest = la cellule de destination.
' Retourne : Vrai si au moins un enregistrement affiché, Faux dans les autres cas.
'-----------------------------------------------------------------------------------------------
Dim MonRs As ADODB.Recordset

' Gestion des erreurs :
Err.Clear
On Error GoTo Gest_Err

' Attente que la connexion soit établie :
If Cnn.State = adStateClosed Then Cnn.Open
If Cnn.State >= adStateConnecting Then
    Application.StatusBar = "Attente de libération de la base..."
    While (Cnn.State = adStateConnecting): DoEvents: Wend
    Application.StatusBar = ""
End If

' Supprime les éventuels crochets sur le nom de la table source :
StrTableSource = Replace(StrTableSource, "[", "")
StrTableSource = Replace(StrTableSource, "]", "")

' Génère la requête SQL complète (si une table est renseigée sinon prend directement SQLWhere) :
If StrTableSource <> "" Then SQLWhere = "SELECT * FROM [" & StrTableSource & "] " & IIf(SQLWhere > "", "WHERE " & SQLWhere, "")
' S'il faut utiliser ORDER BY et que SQLWhere est vide alors efface le WHERE en trop :
SQLWhere = Replace(UCase(SQLWhere), "WHERE ORDER BY", "ORDER BY")

' Affiche la requête :
Application.StatusBar = "Importation : " & Left(SQLWhere, 100)

' Ouverture de la table en lecture seule :
Set MonRs = New ADODB.Recordset
MonRs.Open SQLWhere, Cnn, adOpenStatic, adLockReadOnly, adCmdText

' Si un enregistrement existe alors indique que la sélection retourne bien un enregistrement :
' Et se place sur le premier enregistrement (pour lever toute ambiguïté) :
If MonRs.EOF = False Then
    MonRs.MoveFirst
    RngDest.CopyFromRecordset MonRs
    Enr_Affiche = True
End If

Gest_Err:

' Si le traitement a généré une erreur elle est mémorisée :
MémoriserErreurBase "Enr_Affiche", "[" & StrTableSource & "] : " & SQLWhere

' Désactiver la connexion :
Fermer_Recordset MonRs
Fermer_Connexion Cnn

Application.StatusBar = ""
Err.Clear
End Function

'-----------------------------------------------------------------------------------------------
Function Enr_MAJ(Cnn As ADODB.Connection, StrTableSource As String, _
                 ByVal SQLWhere As String, _
                 ActionMAJ As EnumActionMAJ, _
                 ParamArray ChampEtValeur()) As Boolean
'-----------------------------------------------------------------------------------------------
' Permet la mise à jour de plusieurs champs d'un enregistrement dans une table avec la méthode ADO.
' Cette fonction utilise le nom des champs et leur valeur, qui sont passés en argument (pas
' d'ordre précis à respecter), et non pas une structure Recordset passée en argument.
' Cnn = La connexion à utiliser.
' StrTableSource = Table concernée.
' SQLWhere = Requête SQL permettant d'identifier l'enregistrement par une clé unique (sans le mot clé WHERE).
' S'il n'y a pas besoin d'identifier une clé unique, alors "SQLWhere" peut être vide.
' ActionMAJ = l'une des énumérations suivantes :
'    ModificationUniquement = si l'enregistrement n'est pas trouvé alors génère une erreur.
'    ModificationOuCréation = tente une modification mais si l'enregistrement n'est pas trouvé alors génère une création.
'    Suppression = fait une suppression de l'enregistrement (ou du jeu d'enregistrements).
'    CréationUniquement = force la création de l'enregistrement.
' ChampEtValeur() = Nom du champ à modifier + Valeur du champ. Ce tableau peut avoir jusqu'à 30 couples : champs + valeurs
'                   Si le champ est suivi des caractères distinctifs suivants (+=), (-=), (*=), (/=), (&=) alors
'                   une opération est réalisée sur le champ et non pas une simple mise à jour.
' Un seul enregistrement mis à jour (sauf suppressions) d'où l'importance de bien identifier la clé de l'enregistrement.
' Retourne : VRAI : si un enregistrement est bien mis à jour ou créé.
' Retourne : FAUX : si Erreur.
'-----------------------------------------------------------------------------------------------
Dim MonRs As ADODB.Recordset
Dim i As Integer

' Gestion des erreurs :
Err.Clear
On Error GoTo Gest_Err

' Attente que la connexion soit établie :
If Cnn.State = adStateClosed Then Cnn.Open
If Cnn.State >= adStateConnecting Then
    Application.StatusBar = "Attente de libération de la base..."
    While (Cnn.State = adStateConnecting): DoEvents: Wend
    Application.StatusBar = ""
End If

' Supprime les éventuels crochets sur le nom de la table source :
StrTableSource = Replace(StrTableSource, "[", "")
StrTableSource = Replace(StrTableSource, "]", "")

' Cas particulier si demande de supppression :
If ActionMAJ = Suppression Then

    ADO.Execute_SQL Cnn, "DELETE * FROM [" & StrTableSource & "] " & IIf(SQLWhere > "", "WHERE " & SQLWhere, "")
    GoTo Gest_Err

End If

' Définition de la requête complète :
SQLWhere = "SELECT * FROM [" & StrTableSource & "] " & IIf(SQLWhere > "", "WHERE " & SQLWhere, "")
Application.StatusBar = "Mise à jour : " & SQLWhere

' Défilement Bidirectionnel + verrou à la modification :
Set MonRs = New ADODB.Recordset
MonRs.Open SQLWhere, Cnn, adOpenKeyset, adLockPessimistic, adCmdText

' Si aucun enregistrement existe alors il faut soit passer en mode création AddNew,
' soit générer une erreur, (suivant la valeur de ActionMAJ) :
If MonRs.EOF = True Then
    Select Case ActionMAJ
        Case ModificationOuCréation: MonRs.AddNew
        Case CréationUniquement: MonRs.AddNew
        Case Else: Err.Raise vbObjectError + 513
    End Select
Else
    Select Case ActionMAJ
        Case CréationUniquement: MonRs.AddNew
        Case Else: MonRs.MoveFirst ' Se place sur le premier enregistrement (pour lever toute ambiguïté).
    End Select
End If

' Boucle sur les champs qu'il faut mettre à jour :
For i = 0 To UBound(ChampEtValeur) Step 2

    ' Supprime les éventuels crochets sur le nom du champ :
    ChampEtValeur(i) = Replace(ChampEtValeur(i), "[", "")
    ChampEtValeur(i) = Replace(ChampEtValeur(i), "]", "")

    ' Si le nom du champ est suivi d'un signe particulier, alors faire une opération :
    Select Case Right(ChampEtValeur(i), 4)

        Case "(+=)" ' Ajouter
            ChampEtValeur(i) = Mid(ChampEtValeur(i), 1, Len(ChampEtValeur(i)) - 4)
            MonRs.Fields(ChampEtValeur(i)).Value = MonRs.Fields(ChampEtValeur(i)).Value + ChampEtValeur(i + 1)
        Case "(-=)" ' Soustraire
            ChampEtValeur(i) = Mid(ChampEtValeur(i), 1, Len(ChampEtValeur(i)) - 4)
            MonRs.Fields(ChampEtValeur(i)).Value = MonRs.Fields(ChampEtValeur(i)).Value - ChampEtValeur(i + 1)
        Case "(*=)" ' Multiplier
            ChampEtValeur(i) = Mid(ChampEtValeur(i), 1, Len(ChampEtValeur(i)) - 4)
            MonRs.Fields(ChampEtValeur(i)).Value = MonRs.Fields(ChampEtValeur(i)).Value * ChampEtValeur(i + 1)
        Case "(/=)" ' Diviser
            ChampEtValeur(i) = Mid(ChampEtValeur(i), 1, Len(ChampEtValeur(i)) - 4)
            MonRs.Fields(ChampEtValeur(i)).Value = MonRs.Fields(ChampEtValeur(i)).Value / ChampEtValeur(i + 1)
        Case "(&=)" ' Concatener
            ChampEtValeur(i) = Mid(ChampEtValeur(i), 1, Len(ChampEtValeur(i)) - 4)
            MonRs.Fields(ChampEtValeur(i)).Value = MonRs.Fields(ChampEtValeur(i)).Value & ChampEtValeur(i + 1)

        Case Else ' Mise à jour simple
            MonRs.Fields(ChampEtValeur(i)).Value = ChampEtValeur(i + 1)
        End Select

Next i

' Valide la mise à jour :
MonRs.Update

Gest_Err:

' Si le traitement a généré une erreur elle est mémorisée et retourne FAUX :
Enr_MAJ = MémoriserErreurBase("Enr_MAJ", SQLWhere)

' Désactiver la connexion :
Fermer_Recordset MonRs
Fermer_Connexion Cnn

Application.StatusBar = ""
Err.Clear
End Function

'-----------------------------------------------------------------------------------------------
Function Execute_SQL(Cnn As ADODB.Connection, StrSQL As String, _
                     Optional ActionSiErreur As EnumActionSiErreur = MémoriserErreur) As Boolean
'-----------------------------------------------------------------------------------------------
' Exécute une instruction SQL avec la méthode ADO.
' Cnn : Connexion concernée.
' StrSQL = Requête d'instruction SQL complète.
' ActionSiErreur = l'une des énumérations suivantes :
'       IgnorerErreur = ignore les erreurs.
'       MémoriserErreur = mémorise l'erreur s'il y en a une.
' Retourne : VRAI si la requête est exécutée même si aucun enregistrement n'est sélectionné ou mis à jour.
' Retourne : FAUX si une Erreur est rencontrée ou s'il y a déjà un problème de transaction.
'-----------------------------------------------------------------------------------------------
' Gestion des erreurs :
Err.Clear
On Error GoTo Gest_Err

' Attente que la connexion soit établie :
If Cnn.State = adStateClosed Then Cnn.Open
If Cnn.State >= adStateConnecting Then
    Application.StatusBar = "Attente de libération de la base..."
    While (Cnn.State = adStateConnecting): DoEvents: Wend
    Application.StatusBar = ""
End If

Application.StatusBar = "SQL : " & StrSQL & "..."

' Exécute la requête :
Cnn.Execute StrSQL

' Indique que la requête s'est exécutée correctement :
Execute_SQL = True

Gest_Err:

' Si le traitement a généré une erreur elle est mémorisée :
If ActionSiErreur = MémoriserErreur Then MémoriserErreurBase "Execute_SQL", StrSQL

' Désactiver la connexion :
Fermer_Connexion Cnn

Application.StatusBar = ""
Err.Clear
End Function

'-----------------------------------------------------------------------------------------------
Function Enr_Copie(CnnSource As ADODB.Connection, StrTableSource As String, _
                   SQLWhere As String, _
                   CnnDest As ADODB.Connection, StrTableDest As String, _
                   ActionCopier As EnumActionCopier) As Boolean
'-----------------------------------------------------------------------------------------------
' Permet la copie d'un enregistrement depuis une table vers une autre qui a la même structure (mêmes
' champs et dans le même ordre).
' Remarque : si la table destination à des champs supplémentaires à la table sources, ils ne seront pas renseignés.
' Utilise trois fonctions :
' > Enr_Select : Pour la sélection de l'enregistrement source.
' > Enr_CopieBis : Pour la mise à jour de l'enregistrement destination avec l'enregistrement source.
' > Ajouter_Enr : Pour ajouter l'enregistrement quand il ne s'agit pas d'une mise à jour.
' CnnSource = La connexion de la table source à utiliser.
' StrTableSource = Table source concernée.
' SQLWhere = Requête d'instruction permettant d'identifier la clé unique (sans le mot clé WHERE).
' Un seul enregistrement sélectionné d'où l'importance de bien identifier la clé de l'enregistrement dans le deux tables.
' CnnDest = La connexion de la table destination à utiliser.
' StrTableDest = Table destination concernée.
' ActionCopier = l'une des énumérations suivantes :
'    RemplacerUniquement = si l'enregistrement n'est pas trouvé alors génère une erreur.
'    RemplacerOuCréer = tente une modification mais si l'enregistrement n'est pas trouvé alors génère une création.
'    ForcerCréation = force la création dans la destination (même si l'enregistrement existe).
' Retourne : VRAI si l'action demandée s'est déroulée correctement.
' Retourne : FAUX si une Erreur est rencontrée ou si aucun enregistrement n'est sélectionné.
'-----------------------------------------------------------------------------------------------
Dim MonRs As ADODB.Recordset

' Gestion des erreurs :
Err.Clear
On Error GoTo Gest_Err

' Supprime les éventuels crochets sur le nom de la table source :
StrTableSource = Replace(StrTableSource, "[", "")
StrTableSource = Replace(StrTableSource, "]", "")

' Supprime les éventuels crochets sur le nom de la table destination :
StrTableDest = Replace(StrTableDest, "[", "")
StrTableDest = Replace(StrTableDest, "]", "")

Set MonRs = New ADODB.Recordset

If Enr_Select(CnnSource, StrTableSource, SQLWhere, MonRs, LectureSeule) = True Then

    Select Case ActionCopier

    ' S'il faut forcer la création :
    Case ForcerCréation

        Enr_Copie = Ajouter_Enr(CnnDest, StrTableDest, MonRs)

    ' S'il faut modifier uniquement ou faire la création :
    Case Else

        ' Essaie de faire la modification :
        Enr_Copie = Enr_CopieBis(CnnDest, StrTableDest, SQLWhere, MonRs)

        ' S'il faut faire une création d'enregistrement quand la copie échoue :
        If Enr_Copie = False And ActionCopier = RemplacerOuCréer Then
            Enr_Copie = Ajouter_Enr(CnnDest, StrTableDest, MonRs)
        End If

    End Select

End If

Gest_Err:

' Si le traitement a généré une erreur elle est mémorisée :
MémoriserErreurBase "Enr_Copie", "[" & StrTableSource & "] : " & SQLWhere

' Désactiver la connexion :
Fermer_Recordset MonRs
Fermer_Connexion CnnSource

Err.Clear
End Function

'-----------------------------------------------------------------------------------------------
Private Function Enr_CopieBis(Cnn As ADODB.Connection, StrTableSource As String, _
                               SQLWhere As String, _
                               Enr As ADODB.Recordset) As Boolean
'-----------------------------------------------------------------------------------------------
' Permet la mise à jour d'un enregistrement dans une table avec la méthode ADO.
' Si l'enregistrement n'exite pas, sa mise à jour n'est pas possible, la fonction retourne FAUX.
' Cnnx = La connexion à utiliser.
' StrTableSource = Table concernée.
' SQLWhere = Requête d'instruction permettant d'identifier la clé unique (sans le mot clé WHERE).
' Enr = Structure des enregistrements, utilisée pour la mise à jour des champs de la table.
' Un seul enregistrement mis à jour d'ou l'importance de bien identifier la clé de l'enregistrement.
' Retourne : VRAI si un enregistrement est bien mis à jour.
' Retourne : FAUX si pas d'enregistrement mis à jour car pas de sélection par la requête SQLWhere ou si Erreur.
'-----------------------------------------------------------------------------------------------
Dim MonRs As ADODB.Recordset
Dim i As Integer
Dim Action As Boolean

' Gestion des erreurs :
Err.Clear
On Error GoTo Gest_Err

' Attente que la connexion soit établi :
If Cnn.State = adStateClosed Then Cnn.Open
If Cnn.State >= adStateConnecting Then
    Application.StatusBar = "Attente de libération de la base..."
    While (Cnn.State = adStateConnecting) : DoEvents: Wend
    Application.StatusBar = ""
End If

Application.StatusBar = "Mise à jour de " & StrTableSource & "... ": DoEvents

' Défilement Bidirectionnel + verrou à la modification :
Set MonRs = New ADODB.Recordset
MonRs.Open "SELECT * FROM [" & StrTableSource & "] " & IIf(SQLWhere > "", "WHERE " & SQLWhere, ""), Cnn, adOpenKeyset, adLockPessimistic, adCmdText

' Si un enregistrement existe :
If MonRs.EOF = False Then

        ' Se place sur le premier enregistrement (pour lever toute ambiguïté) :
        MonRs.MoveFirst

        ' Boucle sur tous les champs de l'enregistrement
        ' et les met à jour seulement si changement dans les valeurs.
        ' Attention à la clé primaire !
        Action = False
        For i = 0 To Enr.Fields.Count - 1
            If Nz(MonRs.Fields(i)) <> Nz(Enr.Fields(i)) Then
                MonRs.Fields(i) = Enr.Fields(i)
                Action = True
            End If
        Next i

        ' Mise à jour seulement si besoin :
        If Action = True Then MonRs.Update

        ' Indique que la fonction s'est déroulée correctement, même s'il n'y a pas
        ' eu de modification effectuée car les nouvelles valeurs et les anciennes
        ' valeurs étaient les mêmes :
        Enr_CopieBis = True

End If

Gest_Err:

' Si le traitement a généré une erreur elle est mémorisée :
MémoriserErreurBase "Enr_CopieBis", "[" & StrTableSource & "] : " & SQLWhere

' Désactiver la connexion :
Fermer_Recordset MonRs
Fermer_Connexion Cnn

Application.StatusBar = ""
Err.Clear
End Function

'-----------------------------------------------------------------------------------------------
Private Function Enr_Select(Cnn As ADODB.Connection, StrTableSource As String, _
                            ByVal SQLWhere As String, _
                            ByRef MonRs As ADODB.Recordset, _
                            ModeVerrou As EnumVerrou) As Boolean
'-----------------------------------------------------------------------------------------------
' Permet la sélection d'un enregistrement dans une table avec la méthode ADO. Pour simple lecture ou pour
' sélectionner un enregistrement qui sera par la suite modifié.
' Attention à bien fermer le Recordset dans la suite du code après appel de cette fonction.
' Cnn = La connexion à utiliser.
' StrTableSource = Table concernée (ou une requête dans la base).
'                  Ne pas mettre la table entre crochets "[" et "]" car ils sont automatiquement ajoutés.
'                  Si vide alors l'instruction dans SQLWhere sera utilisée comme requête pour ouvrir la source.
' SQLWhere = Requête d'instruction permettant de sélectionner les enregistrements (sans le mot clé WHERE).
' MonRs = Jeu des enregistrements sélectionnés, utilisé dans la suite du code appelant.
' ModeVerrou = 0 (LectureSeule) : Ouverture de la table en lecture seule.
' ModeVerrou = 1 (LectureEcriture) : Ouverture de la table en lecture écriture.
' Retourne : VRAI si la requête SQL permet la sélection effective d'au moins un enregistrement.
' Retourne : FAUX si une Erreur est rencontrée ou si aucun enregistrement n'est sélectionné.
'-----------------------------------------------------------------------------------------------
' Gestion des erreurs :
Err.Clear
On Error GoTo Gest_Err

' Attente que la connexion soit établie :
If Cnn.State = adStateClosed Then Cnn.Open
If Cnn.State >= adStateConnecting Then
    Application.StatusBar = "Attente de libération de la base..."
    While (Cnn.State = adStateConnecting): DoEvents: Wend
    Application.StatusBar = ""
End If

' Supprime les éventuels crochets sur le nom de la table source :
StrTableSource = Replace(StrTableSource, "[", "")
StrTableSource = Replace(StrTableSource, "]", "")

' Génère la requête SQL complète (si une table est renseignée sinon prend directement SQLWhere) :
If StrTableSource <> "" Then SQLWhere = "SELECT * FROM [" & StrTableSource & "] " & IIf(SQLWhere > "", "WHERE " & SQLWhere, "")
' S'il faut utiliser ORDER BY et que SQLWhere est vide alors efface le WHERE en trop :
SQLWhere = Replace(UCase(SQLWhere), "WHERE ORDER BY", "ORDER BY")

' Ouverture de la table suivant le verrou désiré :
Set MonRs = New ADODB.Recordset

Select Case ModeVerrou

    Case LectureEcriture ' Défilement Bidirectionnel + verrou à la modification.
        MonRs.Open SQLWhere, Cnn, adOpenKeyset, adLockPessimistic, adCmdText

    Case LectureSeule ' Défilement Bidirectionnel + en lecture seule.
        MonRs.Open SQLWhere, Cnn, adOpenStatic, adLockReadOnly, adCmdText

End Select

' Si un enregistrement existe alors indique que la sélection retourne bien un enregistrement :
' Et se place sur le premier enregistrement (pour lever toute ambiguïté) :
If MonRs.EOF = False Then Enr_Select = True: MonRs.MoveFirst

Gest_Err:

' Si le traitement a généré une erreur elle est mémorisée :
MémoriserErreurBase "Enr_Select", "[" & StrTableSource & "] : " & SQLWhere

Application.StatusBar = ""
Err.Clear
End Function

'-----------------------------------------------------------------------------------------------
Private Function Ajouter_Enr(Cnn As ADODB.Connection, StrTableSource As String, _
                             Enr As ADODB.Recordset) As Boolean
'-----------------------------------------------------------------------------------------------
' Permet l'ajout d'un enregistrement dans une table avec la méthode ADO.
' Cnn = La connexion à utiliser.
' StrTableSource = Table concernée.
' Enr = Structure Recordset des enregistrements, utilisée pour l'ajout des champs de la table.
' Retourne : VRAI si un enregistrement est bien ajouté.
' Retourne : FAUX si Erreur.
'-----------------------------------------------------------------------------------------------
Dim MonRs As ADODB.Recordset
Dim i As Integer

' Gestion des erreurs :
Err.Clear
On Error GoTo Gest_Err

' Attente que la connexion soit établie :
If Cnn.State = adStateClosed Then Cnn.Open
If Cnn.State >= adStateConnecting Then
    Application.StatusBar = "Attente de libération de la base..."
    While (Cnn.State = adStateConnecting): DoEvents: Wend
    Application.StatusBar = ""
End If

Application.StatusBar = "Ajout dans " & StrTableSource & "... ": DoEvents

' Défilement Bidirectionnel + verrou à la modification :
Set MonRs = New ADODB.Recordset
MonRs.Open "SELECT * FROM [" & StrTableSource & "]", Cnn, adOpenKeyset, adLockPessimistic, adCmdText

' Passe en mode Ajout :
MonRs.AddNew

' Boucle sur tous les champs de l'enregistrement et fait l'ajout.
' Attention à la clé primaire !
If Not Enr Is Nothing Then
    For i = 0 To Enr.Fields.Count - 1
        MonRs.Fields(i) = Enr.Fields(i)
    Next i
End If

MonRs.Update

Gest_Err:

' Si le traitement a généré une erreur elle est mémorisée et retourne FAUX :
Ajouter_Enr = MémoriserErreurBase("Ajouter_Enr", StrTableSource)

' Désactiver la connexion :
Fermer_Recordset MonRs
Fermer_Connexion Cnn

Application.StatusBar = ""
Err.Clear
End Function

'-----------------------------------------------------------------------------------------------
Private Function MémoriserErreurBase(ErrFonction As String, ErrInstruction As String) As Boolean
'-----------------------------------------------------------------------------------------------
' Cette fonction est appellée par les fonctions de gestion des bases.
' Elle permet de détecter la présence ou non d'une erreur par "Err.Number" et mémorise l'erreur.
' ErrFonction = Le nom de la fonction où l'erreur est générée.
' ErrInstruction : l'instruction qui a généré l'erreur (Err.Number = 0).
' Retourne : VRAI si pas d'erreur, ou FAUX s'il y a une erreur (Err.Number <> 0).
'-----------------------------------------------------------------------------------------------
If Err.Number <> 0 Then
    ' Indique que l'éventuelle transaction en cours sera KO.
    If Cnn_Etat_Transaction <> Transaction_Null Then Cnn_Etat_Transaction = Transaction_KO
    ' Mémorise la première erreur rencontrée et pas les suivantes :
    If ADO_Err_Number = 0 Then
        ADO_Err_Number = Err.Number
        ADO_Err_Description = Err.Description
        ADO_Err_Source = Err.Source
        ADO_Err_Fonction = ErrFonction
        ADO_Err_Instruction = ErrInstruction
    End If
Else
    MémoriserErreurBase = True
End If
End Function

'-----------------------------------------------------------------------------------------------
Function Cnn_Debut(ActionTransaction As EnumActionTransaction) As Boolean
'-----------------------------------------------------------------------------------------------
' Débute un traitement en effaçant les éventuelles erreurs, et ouvre les transactions (sur toutes
' les connexions existantes) si c'est demandé.
' ActionTransaction = l'une des énumérations suivantes :
'                     SansTransaction = sans transaction.
'                     AvecTransaction = avec transactions.
' Retourne VRAI si tout s'est bien passé, ou FAUX en cas d'erreur.
'-----------------------------------------------------------------------------------------------
' Efface les erreurs :
ADO_Err_Number = 0
Err.Clear

' Ouvre les transactions si c'est demandé :
If ActionTransaction = AvecTransaction Then Ouvrir_Toutes_Les_Transactions

' Si tout va bien retourne VRAI :
If Cnn_Etat_Transaction = Transaction_OK And ADO_Err_Number = 0 Then Cnn_Debut = True

End Function

'-----------------------------------------------------------------------------------------------
Function Cnn_Fin(Optional MessageRésultat As EnumMessage = MessageSiErreur) As Boolean
'-----------------------------------------------------------------------------------------------
' Ferme les transactions en cours (en les validant si tout va bien ou les annulant s'il y a une
' erreur détectée), ferme toutes les connexions, affiche un message suivant les cas.
' MessageRésultat = l'une des énumérations suivantes :
'                   SansMessage : pas de message d'affiché même s'il y a une erreur.
'                   MessageSiErreur : message seulement si erreur.
'                   AvecMessage : message si erreur ou non.
' Retourne VRAI si tout s'est bien passé, ou FAUX en cas d'erreur.
'-----------------------------------------------------------------------------------------------

' Si pas d'erreur :
' ~~~~~~~~~~~~~~~~
If ADO_Err_Number = 0 And Err.Number = 0 Then

    Cnn_Fin = True

    ' S'il y a des transactions en cours alors les valide :
    If Cnn_Etat_Transaction <> Transaction_Null Then
        Fin_Des_Transactions
    End If

    ' Ferme toutes les connexions :
    Fermer_Toutes_Les_Connexions

    ' S'il faut afficher un message pour signaler que tout s'est bien passé :
    If MessageRésultat = AvecMessage Then
        MsgBox "Le traitement s'est déroulé correctement.", vbOKOnly, ThisWorkbook.Name
    End If

End If

' S'il y a une erreur de l'application (mais pas de traitement ADO) :
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If Err.Number <> 0 And ADO_Err_Number = 0 Then

    ' Mémorise l'erreur (car elle sera effacée par la suite) :
    ADO_Err_Number = Err.Number
    ADO_Err_Description = Err.Description
    ADO_Err_Source = Err.Source

    ' S'il y a des transactions en cours alors les annule :
    If Cnn_Etat_Transaction <> Transaction_Null Then
        Cnn_Etat_Transaction = Transaction_KO
        Fin_Des_Transactions
    End If

    ' Ferme toutes les connexions :
    Fermer_Toutes_Les_Connexions

    ' Affiche le message si demandé :
    If MessageRésultat >= MessageSiErreur Then

        MsgBox "Erreur : " & ADO_Err_Number & vbCrLf & vbCrLf _
             & "Description : " & ADO_Err_Description & vbCrLf & vbCrLf _
             & "Source : " & ADO_Err_Source & vbCrLf & vbCrLf _
                , vbCritical, "L'application rencontre une erreur de traitement"

    End If

    ' Efface le numéro qui vient en fait de Err.number :
    ADO_Err_Number = 0

End If

' S'il y a une erreur de traitement ADO :
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
If ADO_Err_Number <> 0 Then

    ' S'il y a des transactions en cours alors les annule :
    If Cnn_Etat_Transaction <> Transaction_Null Then
        Cnn_Etat_Transaction = Transaction_KO
        Fin_Des_Transactions
    End If

    ' Ferme toutes les connexions :
    Fermer_Toutes_Les_Connexions

    ' Affiche le message si demandé :
    If MessageRésultat >= MessageSiErreur Then

        MsgBox "Erreur : " & ADO_Err_Number & vbCrLf & vbCrLf _
             & "Description : " & ADO_Err_Description & vbCrLf & vbCrLf _
             & "Source : " & ADO_Err_Source & vbCrLf & vbCrLf _
             & "Fonction : " & ADO_Err_Fonction & vbCrLf & vbCrLf _
             & "Instruction : " & ADO_Err_Instruction & vbCrLf & vbCrLf _
             , vbCritical, "L'application rencontre une erreur de traitement des bases"

    End If

End If

End Function

'-----------------------------------------------------------------------------------------------
Private Function Nz(V As Variant) As Variant
'-----------------------------------------------------------------------------------------------
    If IsNull(V) = True Then Nz = "" Else Nz = V
End Function
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------