Un classeur Excel multi-utilisateur

Comment partager un classeur Excel sur un réseau d’entreprise pour la saisie de données

Laurent Ott

Dans cet article vous allez apprendre à programmer un classeur Excel pour qu’il soit accessible par plusieurs utilisateurs simultanément en lecture et en écriture pour y saisir des données.

Les données seront enregistrées dans une base Access et la technologie ADODB permettra d’y accéder en mode multi-utilisateur.

Elles seront consultées comme dans un classeur Excel ordinaire ce qui rend cette interface transparente.

Vous pouvez déposer vos commentaires dans cette discussion.

- Titre : Un classeur Excel multi-utilisateur

- Auteur : Laurent Ott

- Parution : 24 septembre 2021

- Licence : Le contenu de cet article est rédigé par Laurent Ott et est mis à disposition selon les termes de la Licence Creative Commons Attribution - Pas d'Utilisation Commerciale 3.0 non transposé. Les logos Developpez.com, en-tête, pied de page, css, et look & feel de l'article sont Copyright ® 2013 Developpez.com.

Voir également :

- Tome 1 - Des bases de la programmation à l'algorithme de classement rapide QuickRanking

- Tome 2 - Des bases de la programmation en mode graphique à la programmation d'un jeu d'arcade en VBA et Microsoft Excel

- Tome 3 - Problème du Voyageur de commerce - Une méthode d'approximation basée sur des principes simples

- Tome 4 - Un algorithme de chiffrement/déchiffrement des cellules pour une meilleure confidentialité

- Tome 5 - Sentinelle - Une application qui veille sur vos classeurs sensibles - Exemples d'utilisations des tableaux de données et des requêtes SQL en VBA

- Tome 6 - Apprendre la programmation de nouvelles fonctions Excel pour l'utilisateur

- Comprendre la méthode de factorisation du Crible Quadratique

- Programmation en VBA de menus personnalisés pour Excel

- Manipuler les données des bases Access depuis Excel

- Transfert des fichiers volumineux sous Outlook

- Algorithme ECM de factorisation par les courbes elliptiques

- Un classeur Excel multi-utilisateur

- Compresser/décompresser des fichiers au format ZIP

- Fonctions en VBA pour gérer les Tableaux Structurés d’Excel

- Fonctions en VBA pour générer des courriels formatés HTML

Sommaire

- I. Introduction

- II. Exemple d’une application partagée où seules certaines cellules doivent être enregistrées

- II-A. La base Access

- II-B. Le classeur Excel

- II-C. Sécuriser les données

- III. Exemple d’une application partagée où les données sont structurées

- III-A. La base Access

- III-B. Le classeur Excel

- III-B-1. Le code évènementiel à l’ouverture du classeur

- III-B-2. Alimenter le tableau structuré

- III-B-3. L’évènement au changement d’une cellule de la feuille

- III-B-4. Les fonctions de gestion des enregistrements (ajout, suppression)

- IV. Conclusion

- V. Remerciements

- VI. Les fichiers joints

- VII. Annexe – Module « Saisies_Excel » – Enregistrer/importer les formules des cellules

- VIII. Annexe – Module « TD » - Effacer et redimensionner un tableau structuré

- IX. Annexe – Module « ADO » - Manipuler les données des base Access depuis Excel

I - Introduction

Dans une entreprise il arrive que plusieurs personnes doivent travailler sur un même classeur Excel déposé sur un réseau partagé.

Quand il s’agit uniquement de consultation, la solution est simple : il suffit de le mettre en lecture seule ce qui permet à tous de l’ouvrir.

Mais quand les utilisateurs doivent renseigner des données, ça devient plus compliqué si l’on ne dispose pas d’une solution de partage telle qu’Excel 365…

Car avec les autres versions d’Excel seul le premier utilisateur qui ouvre le classeur peut le modifier, puis le ferme pour le laisser disponible aux autres. Cela nécessite que les interventions soient de courte durée pour ne pas bloquer ceux qui attendent leur tour.

Excel offre la possibilité de mettre le classeur en mode partagé grâce au menu « Révision / Partager le classeur »(1). En théorie cela pourrait répondre au besoin, car ainsi plusieurs utilisateurs peuvent le modifier en même temps, mais en pratique j’ai constaté de trop nombreux plantages et pertes de données pour adopter cette solution.

Je propose ici une autre approche : enregistrer les données dans une base Access et utiliser un classeur Excel en lecture seule comme interface pour permettre aux utilisateurs de les consulter et de les modifier en mode multi-utilisateur.

De par mon expérience je trouve cette méthode plus efficace, mais elle nécessite une programmation en VBA que nous allons étudier dans les chapitres suivants à travers deux exemples : dans le premier seules certaines cellules doivent être enregistrées ; dans le second les données sont bien organisées et s’intègrent en toute logique dans une base Access et seront restituées dans un tableau structuré d’Excel.

Pour interagir avec Access, nous utiliserons les fonctions détaillées dans la documentation Manipuler les données des bases Access depuis Excel dont je vous recommande la lecture pour bien comprendre la suite (voir en annexe un résumé de ces fonctions). Les débutants en VBA acquerront le niveau nécessaire avec le tutoriel « Tome 1 - Des bases de la programmation à l'algorithme de classement rapide QuickRanking ».

Vous aurez aussi besoin de créer des tables dans Access.

Les notions nécessaires à ces manipulations étant hors du sujet de cette documentation, je vous invite à consulter la page des cours Access du site « developpez.com » si besoin.

Cette documentation a été réalisée avec Access et Excel 2016 version 32 bits.

II - Exemple d’une application partagée où seules certaines cellules doivent être enregistrées

Pour expliquer le code VBA mis en œuvre, nous allons étudier le cas du classeur Excel ci-dessous, nommé « Fichier_Partagé.xlsm », où seules les cellules en fond bleu sont modifiables par les utilisateurs pour y renseigner des valeurs ou des formules.

Ces cellules ont été nommées avec en préfixe « ADO_ » afin de les différencier des autres :

Pour information, le nom d’une cellule est attribué par le menu « Formules / Gestionnaire de noms ».

Attribuer un nom à une cellule permet de la déplacer sans que cela influence le code VBA qui y fait référence.

Vous trouverez en annexe une façon rapide pour nommer plusieurs cellules.

Bien évidemment un classeur qui contient si peu de données à renseigner ne nécessite pas d’être partagé, vous devinez que c’est juste pour expliquer la méthode et les fonctions utilisées.

II-A - La base Access

Comme présenté dans l’introduction, les données seront enregistrées dans une base Access.

La première étape consiste à créer cette base et la table nommée arbitrairement « Saisies_Excel » qui contiendra les données.

Les quatre champs de la table « Saisies_Excel » contiendront :

- le nom de la cellule concernée (format texte court de 255 caractères) ;

- sa « formule » (format texte long) ;

- le nom de l’utilisateur (format texte court de 255 caractères) ;

- la date de la modification (format date/heure).

Ces deux derniers champs permettant une traçabilité des modifications effectuées. Nous y reviendrons dans les lignes qui suivent.

Enregistrer la formule de la cellule (plus précisément la propriété Formula) plutôt que la valeur permet de restituer le contenu exact de la cellule, mais aussi d’enregistrer des formules comme dans notre exemple où la cellule "B5" fait référence à "B4" (la date de confirmation est 10 jours après la date de validation et l’utilisateur a préféré saisir une formule que de ressortir son calendrier).

La base Access sera enregistrée dans le même répertoire que le classeur Excel et portera le même nom, dans notre exemple « Fichier_Partagé.accdb ».

II-B - Le classeur Excel

Prérequis :

- il n’y a qu’un seul classeur, en lecture seule pour permettre à tous de l’utiliser simultanément ;

- dans notre exemple, ce classeur est nommé « Fichier_Partagé.xlsm » ;

- chaque cellule à enregistrer est nommée et son nom commence par « ADO_ » pour la différencier des autres cellules nommées du classeur (et qui ne sont pas à enregistrer) ;

- une programmation en VBA étant nécessaire pour interagir avec la base Access utilisée pour enregistrer les données, il convient de recopier dans votre projet les deux modules suivants que vous trouverez dans le fichier joint et dans les annexes :
- « ADO » (dans les lignes qui suivent dans cette documentation, toutes les fonctions faisant appel à ce module seront préfixées, par exemple ADO.Cnn_Initialise, ce qui est facultatif, mais permet d’avoir l’aide intuitive d’Excel lors de la saisie des fonctions, c’est une habitude de programmation que j’ai prise, mais ne vous impose pas),
- « Saisies_Excel » ;

- cette programmation faisant appel à des ressources Access vous devez importer depuis l’éditeur Visual Basic, menu « Outils / Références », les bibliothèques suivantes dans votre projet :
- Microsoft Access 16.0 Object Library,
- Microsoft ADO Ext. 6.0 for DDL and Security,
- Microsoft DAO 3.6 Object Library ;

- la base Access est dans le même dossier que l’application Excel et porte le même nom (sauf son extension, soit « Fichier_Partagé.accdb ») ;

- un code évènementiel à l’ouverture du classeur définit la base Access utilisée et importe les données, c’est-à-dire la procédure Private Sub Workbook_Open() de l’objet ThisWorkbook ;

- un code évènementiel au changement d’une cellule de la feuille, Worksheet_Change, enregistre instantanément dans la base Access les modifications faites d’une cellule préfixée « ADO_ ».

Copiez ce code dans l’objet ThisWorkbook.

'------------------------------------------------------------------------------------------------------
Private Sub Workbook_Open()
'------------------------------------------------------------------------------------------------------
Dim BaseAccess As String
BaseAccess = Replace(ThisWorkbook.Path & "\" & ThisWorkbook.Name, ".xlsm", ".accdb")

If ADO.Cnn_Initialise(Cnn1, BaseAccess) = True Then
Saisies_Excel_Importer
Else
MsgBox "Erreur d'ouverture de la base " & BaseAccess _
& vbCrLf & "Veuillez contacter votre administrateur.", vbCritical
End If
End Sub
'------------------------------------------------------------------------------------------------------

ThisWorkbook.Path renvoie le chemin où est l’application.

ThisWorkbook.Name renvoie le nom de l’application.

Replace(ThisWorkbook.Path & "\" & ThisWorkbook.Name, ".xlsm", ".accdb") remplace l’extension « .xlsm » par « .accdb » pour obtenir la base Access à utiliser. Souvenez-vous qu’elle sera située dans le répertoire que l’application et porte le même nom.

La fonction ADO.Cnn_Initialise initialise une connexion à cette base. Elle renvoie True si tout va bien et dans ce cas les données sont chargées par la fonction Saisies_Excel_Importer (contenue dans le module « Saisies_Excel » que vous avez importé) dont le code est repris ci-dessous, et que je vous explique :

Le but est de boucler sur les cellules du classeur dont le nom commence par « ADO_ » pour y placer la formule enregistrée dans la base Access.

En VBA le nom est précédé de la feuille, soit par exemple « Feuil1!ADO_Budget_Validé_EST », la recherche portera donc sur « !ADO_ ».

Nous avons vu que la table « Saisies_Excel » contient deux champs qui permettent la traçabilité des modifications apportées. Sujet sensible… Car si savoir qui a fait quoi et quand est parfois utile, cela peut être mal vécu par certains utilisateurs. Alors je vous recommande une grande prudence dans vos développements.

J’ai retenu comme solution une variable publique Saisie_Excel_Tracabilite à initialiser à True dans l’évènement à l’ouverture du classeur si vous souhaitez que s’affiche en commentaire des cellules le nom de l’utilisateur et la date de mise à jour.

Cette procédure fait appel aux fonctions du module « ADO » détaillées dans la documentation Manipuler les données des bases Access depuis Excel et qui sont résumées en annexe.

Ici sont utilisées :

- ADO.Cnn_Debut pour commencer un traitement sur la base Access ;

- ADO.Enr_Info pour renvoyer la valeur d’un champ ;

- ADO.Cnn_Fin pour terminer le traitement et afficher un message en cas d’erreur.

'------------------------------------------------------------------------------------------------------
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

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

Vous pouvez prévoir un bouton dans votre classeur pour lancer la fonction Saisies_Excel_Importer afin d’actualiser les données et visualiser les modifications faites par les autres utilisateurs.

Nous avons évoqué un code évènementiel au changement d’une cellule de la feuille, Worksheet_Change, pour enregistrer dans la base Access les modifications faites d’une cellule préfixée « ADO_ ».

Ajoutez ce code à chaque feuille contenant des cellules qu’il faut enregistrer :

'------------------------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'------------------------------------------------------------------------------------------------------
Saisies_Excel_Enregistrer Target
End Sub
'------------------------------------------------------------------------------------------------------

La fonction Saisies_Excel_Enregistrer (elle aussi contenue dans le module « Saisies_Excel » que vous avez importé) permet d’enregistrer dans la base la formule des cellules modifiées.

Nous allons voir son code :

Le but est de boucler sur les cellules modifiées (généralement il n’y en a qu’une à la fois, mais il peut y en avoir plusieurs suite à un copier/coller d’un tableau par exemple) et de ne traiter que celles dont le nom commence par « ADO ».

Dans ce cas la fonction ADO.Enr_MAJ enregistre la nouvelle formule et les informations pour la traçabilité.

ADO.Cnn_Debut et ADO.Cnn_Fin gèrent le déroulement du traitement pour afficher un message en cas d’erreur.

InStr(1, C.Name.Name, "!ADO_", vbTextCompare) interroge le nom de la cellule. Si elle n’en a pas une erreur système est provoquée, d’où la présence de On Error Resume Next en première ligne.

'------------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------------

Quand l’administrateur devra faire évoluer le classeur en ajoutant de nouvelles cellules à enregistrer il lui suffira de les nommer avec le préfixe « ADO_ », elles seront automatiquement incorporées à la table « Saisies_Excel » de la base Access dès leur première utilisation.

Il n’oubliera pas de mettre le fichier en lecture seule après sa mise à jour.

Un seul fichier étant utilisé, situé dans un dossier accessible à tous, la mise en production d’une nouvelle version de votre application ne nécessite pas d’intervenir sur le poste des utilisateurs.

II-C - Sécuriser les données

La base Access et le classeur Excel étant déposés sur un réseau accessible à plusieurs personnes, il est recommandé d’apporter un minimum de sécurité aux données, au moins pour se prémunir des maladresses des utilisateurs trop curieux.

Une manipulation très simple permet de masquer une table d’une base Access, via un clic droit puis le menu « Propriétés de la table », cochez l’attribut « Masqué ».

Pour voir la table, l’utilisateur devra activer l’affichage des objets masqués, ce qui n’est pas une option par défaut.

Pour plus de sécurité, il est possible de mettre un mot de passe sur la table :

- Après avoir fermé la table, ouvrez-la en mode exclusif par le menu « Fichier / Ouvrir / Parcourir ».

- Puis dans le menu « Fichier / Options / Paramètres du client » dans la rubrique « Avancé » cliquez sur « Utiliser le chiffrement hérité ».

- Enfin dans le menu « Fichier », cliquez sur « Chiffrer avec mot de passe ».

C’est le choix retenu pour le prochain exemple que nous allons étudier (avec le mot de passe « X »).

Comme pour Access, les protections pour Excel sont symboliques vu leur faible résistance aux pirates, mais sécuriser le projet VBA est le minimum s’il contient le mot de passe de la base Access : dans l’éditeur VBA, menu « Outils / Propriétés de VBAProject / Protection », cochez « Verrouiller le projet pour l’affichage » et saisissez le mot de passe que vous n’oublierez pas.

III - Exemple d’une application partagée où les données sont structurées

Cet autre exemple, plus complexe, vous donnera des idées du code VBA à programmer dans le cas où un tableau structuré peut être utilisé :

L’entreprise possède environ 2 000 agences ouvertes au public réparties sur 10 Directions de Réseau (DdR), elles-mêmes scindées en Directions de Régions (DR). Chaque année, un inventaire de ce parc est réalisé par les logisticiens (un logisticien par DR) pour évaluer les éventuels travaux d’entretien à réaliser.

Cela va du nettoyage des graffitis sur les murs, au changement de la moquette, aux dalles du plafond à rénover, et j’en passe. Une grille de score permet d’attribuer une note finale à l’agence.

Le but est de suivre l’avancement des actions d’entretien proposées, dont le statut passe de « À engager », à « En cours », puis « Réalisé » et le budget accordé, ou « Sans action » si tout est parfait. Quand le statut est « Réalisé » le champ « Réalisé » devra être alimenté par la date du jour par défaut.

Le tout représente 10 000 lignes maximum, sur une douzaine de colonnes, soit totalement dans les capacités d’Excel.

Théoriquement, une cinquantaine de logisticiens peuvent saisir les informations simultanément, car les évaluations sont faites dans des temps limités.

Un classeur partagé en lecture et écriture sur le réseau d’entreprise accessible aux logisticiens est donc nécessaire (souvenez-vous que l’on ne dispose pas d’une solution de partage telle qu’Excel 365) et une traçabilité pour savoir qui a modifié quoi et quand est demandée.

Seules certaines personnes seront habilitées à l’application, un mot de passe ne sera pas requis et l’on se basera simplement sur le nom de l’utilisateur (le code USER) propre à chacun dans l’entreprise (et non modifiable par l’utilisateur).

Les données peuvent être facilement ordonnées dans une base Access et restituées dans un tableau structuré Excel (voir le tutoriel de Pierre Fauconnier sur les tableaux structurés pour plus d’informations).

Sur les cellules seront appliquées des règles de validation pour contrôler les saisies et éviter les incohérences (menu « Données / validation des données »).

Le classeur Excel et la base de données Access devront avoir un minimum de protections pour se prémunir des utilisateurs trop curieux.

III-A - La base Access

Reprenons la base Access « Fichier_Partagé.accdb » de l’exemple précédent pour y ajouter trois tables.

La table « Agences » contiendra les saisies suite à l’inventaire des agences.

Remarques :

- J’ai regroupé dans la même table les informations uniques concernant l’agence (les champs des lignes 2 à 9) et ceux parfois multiples concernant les actions (les champs suivants).
Par exemple si deux actions sont nécessaires pour une agence, deux enregistrements sont créés reprenant les mêmes valeurs pour les champs « CDR » à « Note ». Il aurait été possible de les séparer dans deux tables distinctes et de s’y référer via un lien, mais restons simples car nous ne sommes pas dans un tutoriel sur Access.

- Le champ « Actif » est à « Vrai » par défaut. Il passe à « Faux » en cas de demande de suppression d’une action pour éviter une suppression physique dans la table et permettre ainsi une traçabilité. L’extraction des données prendra donc en compte cette valeur.

Une deuxième table est nécessaire, elle contiendra le référentiel immobilier (la liste des agences) communiqué régulièrement par la comptabilité et alimentée par un copier/coller.

Enfin une table nommée « USER » qui contiendra la liste des utilisateurs habilités et la date de leur dernière connexion :

Remarques :

- Ici aussi le champ « Actif » permet de désactiver un utilisateur sans le supprimer physiquement de la base.

- Même remarque que plus haut, il aurait été possible de créer cette table avec une clé primaire numérique et d’utiliser ce champ comme lien dans la table « Agences » au champ « Qui ». Mais j’ai souhaité faire au plus simple vu la faible masse de données à gérer.

- La gestion de la table « User » se fera par l’administrateur directement dans Access.

III-B - Le classeur Excel

Reprenons aussi le classeur « Fichier_Partagé.xlsm » de l’exemple précédent en y ajoutant le module « TD » pour la gestion du tableau structuré que vous trouverez dans le fichier joint ou en annexe.

La feuille « Accueil » contient les données dans un tableau structuré nommé « Tableau_Agences » et se présente ainsi (tableau en plage "B7:P8", les trois dernières colonnes étant masquées) :

Et quatre autres feuilles :

- Référentiel : un tableau alimenté par une importation de la base Access qui contient le référentiel immobilier des agences et limitera la saisie d’un CDR par une liste de validation ;

- Typologies : un tableau des typologies possibles alimentera la liste de validation de la colonne « Typologie » ;

- Notes : un tableau des notes de 0 à 20 alimentera la liste de validation de la colonne « Note » et empêchera donc la saisie d’une valeur non admise ;

- Statuts : un tableau des statuts possibles alimentera la liste de validation de la colonne « Statut » et limitera donc la saisie à l’une des valeurs admises.

D’autres contrôles de validation de données sont nécessaires :

- Rénovation : doit être une date comprise entre le 01/01/2000 et le 31/12/2100 ;

- Action : doit avoir une taille de 255 caractères maximum ;

- Budget : doit être un nombre compris entre 0 et 999 ;

- Réalisé : doit être une date comprise entre le 01/01/2021 et le 31/12/2100.

Ces contrôles de validation sont paramétrés dans le menu « Données / validation des données ».

Par exemple pour le CDR et la Rénovation :

L’avantage d’un tableau structuré est que ces critères de validations seront automatiquement reportés sur la ligne suivante en cas de création d’un enregistrement.

Le code VBA de l’application se compose de quatre parties que nous allons étudier :

- l’évènement à l’ouverture du classeur Workbook_Open ;

- la fonction d’importation des données pour alimenter le tableau structuré Actualiser_Tableau ;

- l’évènement au changement d’une cellule de la feuille Worksheet_Change pour modifier les données ;

- les fonctions de gestion des enregistrements (ajout, suppression).

III-B-1 - Le code évènementiel à l’ouverture du classeur

La procédure Workbook_Open définit la base Access utilisée comme déjà vu dans l’exemple précédent, mais aussi fait des contrôles de cohérence, charge la table du référentiel immobilier et lance la fonction d’importation des données pour le tableau structuré :

'------------------------------------------------------------------------------------------------------
Private Sub Workbook_Open()
'------------------------------------------------------------------------------------------------------
Dim BaseAccess As String

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

' Cette application ne doit pas tourner en lecture/écriture :
if ThisWorkbook.ReadOnly = False Then
Err.Raise vbObjectError, "Workbook Open", "Cette application doit être utilisée en lecture seule" _
& vbCrLf & vbCrLf & "Veuillez contacter votre administrateur."
End If

' Met le curseur en mode attente et active la barre d'état :
Application.Cursor = xlWait
Application.DisplayStatusBar = True

' Ouvre une connexion sur la base Access avec un mot de passe :
BaseAccess = Replace(ThisWorkbook.Path & "\" & ThisWorkbook.Name, ".xlsm", ".accdb")
Provider_MotDePasse = "X"
If ADO.Cnn_Initialise(Cnn1, BaseAccess) = False Then
Err.Raise vbObjectError, "Workbook Open", "Connexion à la base Access impossible. Veuillez contacter votre administrateur."
End If

' Si la table USER est alimentée d'au moins un nom :
Application.StatusBar = "Contrôle l'habilitation de l'utilisateur..."
If ADO.Enr_Info(Cnn1, "User", "", Compte, "*") > 0 Then

' Recherche si l'utilisateur est bien dans la table "User" et quitte s'il ne l'est pas (ou plus):
If ADO.Enr_Info(Cnn1, "User", "[User] ='" & Application.UserName & "' AND [Actif]=True", Compte, "User") = 0 Then
Err.Raise vbObjectError, "Workbook Open", "Utilisateur non habilité à cette application : " & Application.UserName _
& vbCrLf & vbCrLf & "Veuillez contacter votre administrateur."
End If

' Enregistre la dernière connexion de l'utilisateur :
If ADO.Enr_MAJ(Cnn1, "User", "[User] ='" & Application.UserName & "' AND [Actif]=True", ModificationUniquement, "Connexion", Now) = False Then
Err.Raise vbObjectError, "Workbook Open", "Enregistrement de la connexion non réalisé."
End If

End If

' Ouvre Excel en grand :
Application.WindowState = xlMaximized

' Charge la table du référentiel immobilier depuis la plage A1 jusqu’à la fin de la table :
Application.StatusBar = "Charge la table du référentiel immobilier..."
If ADO.Enr_Affiche(Cnn1, "Référentiel", "", Sheets("Référentiel").Range("A1")) = False Then
Err.Raise vbObjectError, "Workbook Open", "La base du Référentiel n'a pas été chargée correctement."
End If

' Lance la mise à jour des données :
Actualiser_Tableau

' Gestion des erreurs :
Gest_Err:
Application.StatusBar = ""
Application.Cursor = xlDefault
If Err.Number <> 0 Then
Set Cnn1 = Nothing
MsgBox "Erreur : " & Err.Number & vbCrLf & vbCrLf _
& "Source : " & Err.Source & vbCrLf & vbCrLf _
& "Description : " & Err.Description, vbCritical, ThisWorkbook.Name
Err.Clear
End If
End Sub
'------------------------------------------------------------------------------------------------------

Quelques remarques :

Une anomalie générera un message personnalisé avec Err.Raise qui bascule le code à l’étiquette de gestion des erreurs initialisée par On Error GoTo.

Les arguments passés sont : le code de l’erreur ; la source ; le descriptif.

Cela évite l’instruction Exit Sub que les puristes n’apprécient pas, car elle complique le débogage, ou GoTo qui est démodée.

Et la connexion à la base sera annulée par Set Cnn1 = Nothing donc il sera impossible d’accéder aux bases, même en lecture.

Le premier contrôle de cohérence est de s’assurer que le classeur est bien en lecture seule :

ThisWorkbook.ReadOnly renvoie True si le classeur est en lecture seule, ou False s’il est en lecture/écriture.

Il faut ouvrir la base Access avec son mot de passe, « X », en le déclarant par :
Provider_MotDePasse = "X"

Si la table « User » est alimentée d’au moins un enregistrement cela signifie qu’une gestion des habilitations est requise, dans ce cas ADO.Enr_Info(Cnn1, "User", "", Compte, "*") > 0.

Il faut alors vérifier que l'utilisateur est bien dans la table et est toujours actif, c’est-à-dire qu’il est habilité à cette application :

ADO.Enr_Info(Cnn1, "User", "[User] = ' " & Application.UserName & " ' AND [Actif]=True", Compte, "User") renvoie 0 si ce n’est pas le cas.

Puis nous enregistrons la date de la dernière connexion de l’utilisateur, en alimentant le champ « Connexion » de la date et l'heure actuelle du système.

Notez que si la base Access est corrompue, ce qui arrive exceptionnellement et nécessite alors qu’elle soit « compactée et réparée », la fonction renvoie False.

ADO.Enr_MAJ(Cnn1, "User", "[User] = ' " & Application.UserName & " ' AND [Actif]=True", ModificationUniquement, "Connexion", Now)

Si les contrôles de cohérence sont corrects, nous pouvons charger le référentiel immobilier qui nous servira lors des saisies.

La table « Référentiel » sera importée dans son intégralité sur une feuille de même nom depuis la plage "A1". Cette plage s’étendra automatiquement en s’adaptant à la taille de la table.

ADO.Enr_Affiche(Cnn1, "Référentiel", "", Sheets("Référentiel").Range("A1"))

III-B-2 - Alimenter le tableau structuré

La fonction Actualiser_Tableau (que vous trouverez dans le module « Main » du classeur joint) importe dans le tableau structuré les données des saisies contenues dans la table « Agences ».

Les données sont importées par la requête qui sélectionne les champs désirés, la condition, l’ordre de tri :

SQL = "SELECT CDR, Libellé, DR, DDR, Rénovation, Typologie, Inventaire, " _
1 "Note, Action, Budget, Statut, Réalisation, Qui, Quand, ID " _
1 "FROM Agences " _
1 "WHERE Actif = True " _
1 "ORDER BY Val(CDR), ID"

« Actif » : doit être à Vrai, comme déjà vu une action « supprimée » passe ce champ à Faux et l’enregistrement n’est pas exporté.

« Val(CDR) » a un tri croissant : les numéros d’agence sont enregistrés dans le champ « CDR » au format texte, pour une restitution par ordre croissant il faut les transformer en numériques, sans quoi 1100 passe devant 999.

« ID » a un tri croissant, afin de classer les actions d’une même agence par ordre de leur création.

'------------------------------------------------------------------------------------------------------
Sub Actualiser_Tableau()
'------------------------------------------------------------------------------------------------------
Dim i As Long, Filtre As Boolean
Dim TD As Range, SQL As String

' Pas de mise à jour de l'écran et suppression des évènements :
Application.StatusBar = "Mise à jour des données..."
Application.Cursor = xlWait
Application.ScreenUpdating = False
Application.EnableEvents = False

' Mémorise le tableau structuré :
Set TD = Range("Tableau_Agences")

' La cellule active doit être une cellule visible du tableau
' pour que la fonction ActiveSheet.FilterMode puisse fonctionner :
Cells(TD.Row - 1, TD.Column).Select

' Si au un filtre est actif alors le supprime :
Filtre = ActiveSheet.FilterMode
If Filtre = True Then TD.AutoFilter

' Efface les anciennes données :
ClearTD TD

' Définition de la requête de sélection des données et de leur tri :
SQL = "SELECT CDR, Libellé, DR, DDR, Rénovation, Typologie, Inventaire, " _
& "Note, Action, Budget, Statut, Réalisation, Qui, Quand, ID " _
& "FROM Agences " _
& "WHERE Actif = True " _
& "ORDER BY Val(CDR), ID"

' Pose les nouvelles données d'après la requête dans le tableau structuré :
ADO.Enr_Affiche Cnn:=Cnn1, StrTableSource:="", SQLWhere:=SQL, RngDest:=TD

' Format Euros pour le budget et numérique pour la note et l'ID :
Range("Tableau_Agences[Budget]").NumberFormat = "#,##0.0"" K€"""
Range("Tableau_Agences[Note]").NumberFormat = "0"
Range("Tableau_Agences[ID]").NumberFormat = "0"

' Restaure les filtres :
If Filtre = True Then TD.AutoFilter

' Fin du traitement de mise à jour :
Application.ScreenUpdating = True
Application.Cursor = xlDefault
Application.StatusBar = ""
Application.EnableEvents = True

End Sub
'------------------------------------------------------------------------------------------------------

Attention : pour que la fonction ActiveSheet.FilterMode détecte si des filtres sont utilisés, il faut que la cellule active soit sur l’une des cellules visibles du tableau structuré.
D’où le traitement réalisé en amont pour activer la cellule haut-gauche du tableau.

La fonction ClearTD efface les lignes du tableau structuré et le redimensionne pour le préparer à recevoir de nouvelles données. Vous la trouverez dans le module « TD » et en annexe.

Le chargement des données se fait en important la requête SQL préalablement définie :
ADO.Enr_Affiche Cnn:=Cnn1, StrTableSource:="", SQLWhere:=SQL, RngDest:=TD

Ce qui donne un tableau comme celui-ci (les trois dernières colonnes masquées contiennent les informations sur la traçabilité et la clé ID de l’enregistrement) :

Depuis ce tableau structuré, l’utilisateur pourra :

- modifier des données directement dans les cellules ;

- ajouter une autre action à une agence existante ;

- ajouter une nouvelle agence ;

- supprimer une action.

III-B-3 - L’évènement au changement d’une cellule de la feuille

L’évènement sur changement Worksheet_Change (de la feuille où se situe le tableau structuré) déclenche la mise à jour des données de la base Access si la cellule modifiée est à l’intérieur du tableau structuré :

'------------------------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'------------------------------------------------------------------------------------------------------
If Not Application.Intersect(Target, Range("Tableau_Agences")) Is Nothing Then
Enregistrer_Ligne Target.Row
End If
End Sub
'------------------------------------------------------------------------------------------------------

La fonction Enregistrer_Ligne (que vous trouverez dans le module « Main » du classeur joint) a en argument le numéro de la ligne qui est modifiée dans la feuille. Pour retrouver la ligne concernée du tableau, il faudra ôter la ligne où commence le tableau.

Par exemple, la ligne 9 de la feuille correspond à la deuxième ligne du tableau structuré « Tableau_Agences » qui commence en ligne 7, car 9 – 7 = 2.

Cette procédure fait appel aux fonctions du module « ADO » détaillées dans la documentation Manipuler les données des bases Access depuis Excel et qui sont résumées en annexe.

Ici sont utilisées :

- ADO.Cnn_Debut pour débuter un traitement sur la base Access ;

- ADO.Enr_MAJ pour enregistrer les données de la ligne concernée ;

- ADO.Cnn_Fin pour terminer le traitement et afficher un message en cas d’erreur.

'------------------------------------------------------------------------------------------------------
Public Sub Enregistrer_Ligne(i As Long)
'------------------------------------------------------------------------------------------------------
Dim TD, Realisation
Dim Id As Long, lg As Long

' Définition du tableau :
Set TD = Range("Tableau_Agences")

' Récupération de l'ID de la ligne active du tableau structuré :
i = i - TD.Row + 1   ' ligne du tableau = ligne active de la feuille - ligne où commence le tableau.
Id = Val(TD(i, TD.ListObject.ListColumns.Item("ID").Index))  ' Recherche l'ID de l'enregistrement.

' Si l'Id existe :
If Id > 0 Then

' Ajoute la date de réalisation si le statut est à "Réalisé" ou l’efface si le statut est différent :
Realisation = TD(i, 12)
If TD(i, 11) = "Réalisé" And TD(i, 12) = "" Then Realisation = Date
If TD(i, 11) <> "Réalisé" Then Realisation = Null

' Bloque les évènements car des cellules vont être modifiées :
Application.EnableEvents = False

' Affiche le libellé de l'agence, la DR, la DDR suivant le CDR :
Do
lg = lg + 1
If Sheets("Référentiel").Cells(lg, "A") = TD(i, 1) Then ' Le Référentiel contient les infos.
TD(i, 2) = Sheets("Référentiel").Cells(lg, "B")     ' Libellé.
TD(i, 3) = Sheets("Référentiel").Cells(lg, "D")     ' DR.
TD(i, 4) = Sheets("Référentiel").Cells(lg, "E")     ' DDR.
Exit Do
End If
Loop While Sheets("Référentiel").Cells(lg, "A") <> ""

TD(i, 12) = Realisation             ' Date de réalisation.
TD(i, 13) = Application.UserName    ' Nom de l'utilisateur.
TD(i, 14) = Now                     ' Date de la mise à jour.

' Restaure les évènements :
Application.EnableEvents = True

' Enregistre les données dans la base Access :
ADO.Cnn_Debut SansTransaction

ADO.Enr_MAJ Cnn1, "Agences", "ID = " & Id, ModificationOuCréation, _
"ID", Id, _
"Qui", Left(Application.UserName, 255), _
"Quand", Now, _
"CDR", TD(i, 1), _
"Libellé", TD(i, 2), _
"DR", TD(i, 3), _
"DDR", TD(i, 4), _
"Rénovation", TD(i, 5), _
"Typologie", TD(i, 6), _
"Inventaire", TD(i, 7), _
"Note", TD(i, 8), _
"Action", TD(i, 9), _
"Budget", TD(i, 10), _
"Statut", TD(i, 11), _
"Réalisation", Realisation

ADO.Cnn_Fin MessageSiErreur

End If
End Sub
'------------------------------------------------------------------------------------------------------

III-B-4 - Les fonctions de gestion des enregistrements (ajout, suppression)

La gestion des enregistrements (ajouter une autre action à une agence existante, ajouter une nouvelle agence, supprimer une action) se fait en cliquant sur les boutons de la feuille.

Vous trouverez les trois fonctions suivantes dans le module « Main » du classeur joint.

L’ajout d’une nouvelle action :

'------------------------------------------------------------------------------------------------------
Sub Action_Cliquer()
'------------------------------------------------------------------------------------------------------
Dim TD, V
Dim Id As Long, Ligne As Long, i As Integer

' Définition du tableau :
Set TD = Range("Tableau_Agences")

' Vérifie que la sélection est dans le tableau :
Selection.Cells(1).Select
If Application.Intersect(Selection, TD) Is Nothing Then
MsgBox "Vous devez sélectionner une cellule du tableau"
Exit Sub
End If

' Recherche la ligne du tableau :
Ligne = ActiveCell.Row - TD.Row + 1

' Bloque les évènements car des cellules vont être modifiées :
Application.EnableEvents = False

' Ajoute une ligne en dessous :
TD.ListObject.ListRows.Add (Ligne + 1)

' Recopie les infos
For i = 1 To 8
TD(Ligne + 1, i) = TD(Ligne, i)
Next i

' Recherche l'ID à créer (maximum utilisé dans la base + 1),
' Renvoie nul dans le cas d'une table vierge donc prendre 1, sinon on ajoute 1 :
V = ADO.Enr_Info(Cnn1, "Agences", "", Maxi, "ID")
If IsNull(V) = True Then Id = 1 Else Id = V + 1

' Pose l'Id dans le tableau car il sera utilisé pour la mise à jour de l'enregistrement :
TD(Ligne + 1, TD.ListObject.ListColumns.Item("ID").Index) = Id

' Présentation :
Application.EnableEvents = True

' Se place sur la première colonne Vide :
i = 1
While TD(Ligne + 1, i) <> "" : i = i + 1 : Wend
TD(Ligne + 1, i).Select

Application.Cursor = xlDefault
End Sub
'------------------------------------------------------------------------------------------------------

L’ajout d’une nouvelle agence :

'------------------------------------------------------------------------------------------------------
Sub Agence_Cliquer()
'------------------------------------------------------------------------------------------------------
Dim TD, V
Dim Id As Long, Ligne As Long

' Définition du tableau :
Set TD = Range("Tableau_Agences")

' Vérifie que la sélection est dans le tableau :
Selection.Cells(1).Select
If Application.Intersect(Selection, TD) Is Nothing Then
MsgBox "Vous devez sélectionner une cellule du tableau"
Exit Sub
End If

' Recherche la dernière ligne du tableau :
Ligne = TD.ListObject.ListRows.Count

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

' Ajoute une ligne en fin de tableau :
Selection.ListObject.ListRows.Add AlwaysInsert:=True

' Recherche l'ID à créer (maximum utilisé dans la base + 1),
' Renvoie nul dans le cas d'une table vierge donc prendre 1, sinon on ajoute 1 :
V = ADO.Enr_Info(Cnn1, "Agences", "", Maxi, "ID")
If IsNull(V) = True Then Id = 1 Else Id = V + 1

' Pose l'Id dans le tableau car il sera utilisé pour la mise à jour de l'enregistrement :
TD(Ligne + 1, TD.ListObject.ListColumns.Item("ID").Index) = Id

' Présentation :
Application.EnableEvents = True
TD(Ligne + 1, 1).Select

Application.Cursor = xlDefault
End Sub
'------------------------------------------------------------------------------------------------------

La suppression d’une action :

'------------------------------------------------------------------------------------------------------
Sub Supprimer_Cliquer()
'------------------------------------------------------------------------------------------------------
Dim TD, i As Long
Dim Id As Long

' Définition du tableau :
Set TD = Range("Tableau_Agences")

' Vérifie que la sélection est dans le tableau :
Selection.Cells(1).Select
If Application.Intersect(Selection, TD) Is Nothing Then
MsgBox "Vous devez sélectionner une cellule du tableau"
Exit Sub
End If

' Récupération de l'ID :
i = ActiveCell.Row - TD.Row + 1
Id = Val(TD(i, TD.ListObject.ListColumns.Item("ID").Index))

' Enregistre le données :
ADO.Cnn_Debut SansTransaction

ADO.Enr_MAJ Cnn1, "Agences", "ID = " & Id, ModificationUniquement, _
"Qui", Left(Application.UserName, 255), _
"Quand", Now, _
"Actif", False

ADO.Cnn_Fin MessageSiErreur

' Nouvelle présentation du tableau :
Actualiser_Tableau

End Sub
'------------------------------------------------------------------------------------------------------

IV - Conclusion

À défaut de disposer d’une solution de partage telle qu’Excel 365, la méthode que je propose dans cette documentation permet de partager un classeur Excel en lecture et écriture pour que plusieurs personnes d’une entreprise puissent enregistrer simultanément des données :

- lorsque quelques cellules sont concernées ;

- lorsque les données peuvent être ordonnées dans une base Access et restituées dans un tableau structuré.

Certes, elle nécessite de la programmation en VBA et n’est donc pas accessible à tous.

Mais j’espère que les explications données ici avec les deux exemples sont suffisamment claires pour que les développeurs disposant d’un minimum de bagage arrivent à l’appliquer.

Vous trouverez dans les fichiers joints le code VBA complet des exemples de cette documentation, dont vous vous inspirerez pour vos applications.

Les trois annexes qui suivent contiennent l’intégralité des codes sources des modules génériques utilisés.

Certains d’entre vous se demanderont pourquoi ne pas utiliser directement Access.

D’une part parce que les utilisateurs sont bien plus familiarisés avec Excel qu’avec Access, ce qui les rassure et permet une adaptation au changement mieux acceptée et donc plus rapide ; d’autre part parce qu’Access est très limité en restitution, avoir sous les yeux dans Excel des données que l’on peut trier, filtrer, tirer, copier, imprimer, exporter, etc. est un plus avec lequel Access ne peut pas rivaliser.

Bonne programmation.

Laurent OTT.
2021.

V - Remerciements

Je remercie Pierre Fauconnier pour sa relecture technique et ses très nombreux conseils de programmation et de rédaction, et escartefigue pour la correction orthographique.

Ainsi que toute l’équipe de Developpez.com qui participe à la maintenance du site.

VI - Les fichiers joints

Vous trouverez les fichiers :

- Fichier_Partage.xlsm qui contient les fonctions étudiées dans cette documentation pour la saisie des données.

- Fichier_Partage.accdb qui contient la base Access (sans ses données qui sont confidentielles, le mot de passe est « X »).

VII - Annexe – Module « Saisies_Excel » – Enregistrer/importer les formules des cellules

Le code ci-dessous reprend l’intégralité du code du module « Saisies_Excel » du fichier joint à cette documentation.

Les fonctions Saisies_Excel_Enregistrer et Saisies_Excel_Importer sont détaillées dans l’exemple d’une application partagée où seules certaines cellules doivent être enregistrées.

La fonction Saisies_Excel_Nom_Ajouter attribue un nom aux cellules préalablement sélectionnées qui reprend le préfixe « ADO_ » suivi d’un numéro d’ordre. Cela vous simplifiera la tâche si vous avez besoin de nommer de nombreuses cellules.

Les cellules déjà nommées ne sont pas impactées et conservent leur nom. Vous pouvez supprimer les noms des cellules en utilisant la fonction Saisies_Excel_Nom_Supprimer.

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
'------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------

VIII - Annexe – Module « TD » - Effacer et redimensionner un tableau structuré

La fonction ClearTD efface les lignes du tableau structuré et le redimensionne pour le préparer à recevoir de nouvelles données.

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
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------

IX - Annexe – Module « ADO » - Manipuler les données des base Access depuis Excel

Pour interagir avec Access nous avons utilisé les fonctions détaillées dans la documentation Manipuler les données des bases Access depuis Excel dont voici un résumé :

Function Cnn_Initialise(Cnn As ADODB.Connection, StrBaseSource As String) As Boolean

Définit un fournisseur de données pour initialiser une connexion.

Ses arguments sont :

- Cnn : l’objet connexion concerné (entre Cnn1 et Cnn9) ;

- StrBaseSource : base concernée (chemin complet + nom avec l'extension).

Function Cnn_Debut(ActionTransaction As EnumActionTransaction) As Boolean

Réinitialise le gestionnaire des erreurs différées et, si demandé, ouvre une transaction.

Son argument est :

- ActionTransaction prenant l'une des énumérations suivantes :
- SansTransaction = pas de transaction générée,
- AvecTransaction = ouvre une transaction (sur toutes les connexions existantes).

Function Enr_Info(Cnn As ADODB.Connection, StrTableSource As String, _ ByVal SQLWhere As String, TypeInfoEnr As EnumInfoEnr, _ ByVal StrNomChamp As String) As Variant

Renvoie des informations sur l’enregistrement désiré.

Ses arguments sont :

- Cnn : l’objet connexion concerné (entre Cnn1 et Cnn9) ;

- StrTableSource : la table concernée ;

- SQLWhere : requête d'instruction permettant d'identifier l’enregistrement concerné ;

- TypeInfoEnr prenant l'une des énumérations suivantes :
- Valeur = retourne la valeur du champ désiré,
- Compte = compte le nombre d'enregistrements (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'enregistrements ;

- StrNomChamp : le nom du champ concerné.

Function Enr_Affiche(Cnn As ADODB.Connection, StrTableSource As String, _ ByVal SQLWhere As String, RngDest As Range) As Boolean

Ouvre un jeu d’enregistrements et l’affiche dans une feuille de calcul.

Ses arguments sont :

- Cnn : l’objet connexion concerné (entre Cnn1 et Cnn9) ;

- StrTableSource : la table concernée ;

- SQLWhere : requête d'instruction permettant d'identifier le jeu d’enregistrements ;

- RngDest : est la cellule où afficher le jeu d’enregistrements.

Function Enr_MAJ(Cnn As ADODB.Connection, StrTableSource As String, ByVal SQLWhere As String, _ ActionMAJ As EnumActionMAJ, ParamArray ChampEtValeur()) As Boolean

Permet de modifier, créer ou supprimer un enregistrement.

Ses arguments sont :

- Cnn : l’objet connexion concerné (entre Cnn1 et Cnn9) ;

- StrTableSource : la table concernée ;

- SQLWhere : requête d'instruction permettant d'identifier l’enregistrement ;

- ActionMAJ prenant l'une des énumérations suivantes :
- ModificationUniquement = tente une modification, ou génère une erreur,
- ModificationOuCréation = tente une modification, ou génère une création,
- Suppression = fait une suppression de l'enregistrement (ou du jeu d'enregistrements),
- CréationUniquement = création d’un nouvel enregistrement ;

- ChampEtValeur : nom du champ à modifier + Valeur du champ. Ce tableau de type Array peut avoir jusqu'à 30 couples : champ + valeur.

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

Copie un enregistrement d’une table vers une autre.

Ses arguments sont :

- CnnSource : l’objet connexion qui contient la source (entre Cnn1 et Cnn9) ;

- StrTableSource : la table source concernée ;

- SQLWhere : requête d'instruction permettant d'identifier l’enregistrement concerné ;

- CnnDest : l’objet connexion qui contient la destination (entre Cnn1 et Cnn9) ;

- StrTableDest : la table destination concernée ;

- ActionCopier prenant 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, ou génère une création,
- ForcerCréation = force la création dans la destination (même si l'enregistrement existe).

Function Execute_SQL(Cnn As ADODB.Connection, StrSQL As String, _ Optional ActionSiErreur As EnumActionSiErreur = MémoriserErreur) As Boolean

Exécute une instruction SQL, pour faire une mise à jour, une création, une suppression, sur un enregistrement ou un jeu d’enregistrements. Ou pour faire toute autre action que le SQL permet de faire.

Ses arguments sont :

- Cnn : l’objet connexion concerné (entre Cnn1 et Cnn9) ;

- StrSQL : la requête d’instruction SQL complète ;

- ActionSiErreur prenant l'une des énumérations suivantes :
- IgnorerErreur = ignore les erreurs,
- MémoriserErreur = mémorise l'erreur s'il y en a une, pour un traitement différé.

Function Cnn_Fin(Optional MessageRésultat As EnumMessage = MessageSiErreur) As Boolean

Ferme la transaction et les connexions, affiche les messages d’erreur mis en différé.

Son argument est :

- MessageRésultat prenant 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 message de confirmation si pas d’erreur.

'-----------------------------------------------------------------------------------------------
' 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
'-----------------------------------------------------------------------------------------------
'-----------------------------------------------------------------------------------------------

(1) Le partage du classeur n'est plus possible via « Révision » sur les versions actuelles, le partage étant géré par OneDrive, SharePoint ou Teams.