IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)

Apprendre la programmation en VBA pour EXCEL par la pratique - Cinquième partie

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

Dans la dynamique de la série de cours pour apprendre VBA de Excel, par la pratique, une cinquième partie orientée sécurité, comme la quatrième partie, vient avec un accent particulier sur les requêtes SQL en VBA.

Un espace de partage vous est proposé sur le forum pour recevoir vos avis. 52 commentaires Donner une note à l´article (5)

Article lu   fois.

L'auteur

Profil Pro

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

I. Avant-propos

Je ne sais pas si vous êtes tombé sur ce mémento par hasard, mais sachez que je l'ai écrit… par hasard.
Tout a commencé par la remarque d'une collègue, persuadée que sa saisie dans un classeur du réseau avait été modifiée. Comment s'en assurer ?

J'ai écrit Sentinelle pour tenter de répondre à cette question et j'ai présenté ce projet aux membres de Developpez.com en leur demandant leur avis sur l'utilité d'une telle application. Pierre Fauconnier, mon mentor, était partant sur le principe, mais quand il a lu le code source il m'a gentiment retoqué, du genre « C'est du code Spaghetti et tu peux faire mieux. »
Il évoquait aussi l'usage des tableaux de données : jamais entendu parler. Qu'est-ce que c'est ? À quoi ça sert ?
Un autre coup du destin a voulu que justement je venais de travailler sur les requêtes SQL en préparation de mon prochain mémento, alors quand j'ai approfondi l'étude des tableaux de données, j'ai vite compris le potentiel qu'on pouvait tirer de ce mariage.
Bingo, Pierre venait de me fournir un sujet de mémento très intéressant.

C'est pourquoi je dédicace ce mémento à Pierre Fauconnier.

II. Introduction

Si vous avez lu le tome 4 de cette série, vous savez qu'Alice est terrifiée à l'idée que ses collègues puissent modifier à son insu ses classeurs placés sur le réseau partagé : l'option EXCEL de protection des cellules par mot de passe n'est guère efficace contre les pirates, ou dans certains cas est impossible à appliquer, comme sur le classeur du réseau géré par son responsable hiérarchique où Alice, mais aussi tous les autres membres de l'équipe enregistrent leurs congés.
Dans ces conditions comment Alice peut-elle savoir si sa saisie a été modifiée par un intrus malintentionné ou par un collaborateur un peu gauche, et comment la restaurer ?

Ce n'est pas bien compliqué, me répondrez-vous, il suffit de faire une copie du fichier source sur son disque dur, de consulter régulièrement ses fichiers pour s'assurer de leur conformité, et en cas de doute, de recopier la partie qui pose problème.

Sauf que cela nécessite des manipulations, de la rigueur et surtout… du temps.

J'ai donc développé une application qui veille sur vos classeurs : elle calcule, pour les cellules déclarées « sensibles » dans un classeur, une valeur correspondant à leur contenu pondéré par leurs coordonnées, on parle aussi d'empreinte. Une variation de cette valeur de référence trahit une modification des cellules (contenu ou emplacement, taille de la police, de la couleur du texte ou du fond) et déclenche sur demande la restauration de la sauvegarde.
Cette application s'appelle Sentinelle, car elle permet d'un clic de lancer le contrôle de l'ensemble des classeurs déclarés sensibles, sans manipulation autre que l'éventuelle saisie des mots de passe qui protègent les fichiers.

Vous trouverez la présentation des fonctionnalités de cette application dans le chapitre suivant.

Les autres chapitres, qui vont plus intéresser les programmeurs, s'appuient sur le code source de l'application pour étudier l'utilisation en VBA des tableaux de données et des requêtes SQL : deux techniques aussi simples à mettre en œuvre qu'efficaces, et qui peuvent vous rendre de grands services dans vos applications.

Nous n'aborderons pas ici la conception des UserForm, pour cela je vous invite à lire l'incontournable tutoriel de SilkyRoad à cette adresse : https://silkyroad.developpez.com/VBA/UserForm/.
Ainsi que la FAQ à cette adresse : https://excel.developpez.com/faq/?page=Form#USF.

Je conseille aux débutants en VBA de lire le tome 1 afin d'acquérir les connaissances nécessaires.
Cette application a été testée avec EXCEL 2010 sous Windows 7 et avec EXCEL 2016 sous Windows 10.

III. Présentation des fonctionnalités de l'application Sentinelle

À son chargement l'application Sentinelle installe un menu personnalisé dans l'onglet « Compléments » du ruban. C'est par ce menu que vous accédez aux différentes fonctions.
Pensez à « activer les macros » si besoin.

Image non disponible

Vous pouvez désormais créer une sauvegarde qui servira à restaurer des cellules modifiées, ou une feuille entière.

Ouvrez le classeur concerné :
- si une seule cellule ou une plage de cellules contiguës doit être sauvegardée : la sélectionner puis dans le menu « Sentinelle » choisir « Sauvegarder / Sauvegarder la plage sélectionnée » ;
- pour une feuille entière : l'activer puis dans le menu « Sentinelle » choisir « Sauvegarder / Sauvegarder la feuille active » ;
- pour toutes les feuilles du classeur : dans le menu « Sentinelle » choisir « Sauvegarder / Sauvegarder tout le classeur actif ».

Vous pouvez sauvegarder soit une feuille soit une (ou des) plage(s) dans la feuille, mais pas les deux à la fois, car cela n'a aucun sens. Sauvegarder une feuille supprime les éventuelles sauvegardes de plages, et inversement sauvegarder une plage supprime l'éventuelle sauvegarde de la feuille.

Les cellules sont copiées dans un fichier situé dans le sous-répertoire « Sauvegardes_Sentinelle ». Le nom de ce fichier correspond à la date du traitement au format jour-mois-année-heure-minute-seconde.
Sur la feuille « Sauvegardes » de l'application Sentinelle, une nouvelle ligne est créée. Elle contient le chemin du classeur, son nom, la feuille concernée et éventuellement la plage, la date de la sauvegarde, la valeur de l'empreinte, et enfin si le classeur doit être suivi ou non en sentinelle (Oui par défaut).

Image non disponible

Remarque : pour éviter les confusions et forcer le mode alphanumérique, le nom des classeurs et des feuilles sont placés entre accolades { } car EXCEL accepte un nom de feuille comme celui-ci « -1+5 ».

Dans le cas inverse, pour contrôler un classeur, deux méthodes sont possibles.

La première méthode est de passer par le formulaire de gestion des sauvegardes : via le menu « Sentinelle » choisir « Gérer les sauvegardes », puis sélectionnez la ou les sauvegardes à contrôler et cliquez sur le bouton « Contrôler la sélection ».

Image non disponible

1 : Un clic sur la ligne la sélectionne. Elle passe alors en fond bleu. Maintenez la touche [Ctrl] enfoncée pour faire une sélection multiple. Utilisez les touches [Ctrl] +[Majuscule] pour sélectionner plusieurs lignes à la fois.
2 : Lance le contrôle des sauvegardes sélectionnées.
3 : Le détail de la dernière ligne sélectionnée (répertoire, nom du fichier, feuille et plage à contrôler, date de la sauvegarde) s'affiche ici.
4 : Supprime les sauvegardes sélectionnées.
5 : Restaure la situation d'origine, c'est-à-dire celle à l'ouverture du formulaire. À utiliser si vous avez supprimé des sauvegardes par erreur.
6 : Ces deux boutons passent les sauvegardes sélectionnées au statut suivi en sentinelle à « Oui/Non ».
7 : Ces quatre boutons servent de filtres pour simplifier vos sélections. Lorsqu'un filtre est appliqué, le libellé du filtre est affiché en rouge.
8 : Permet d'effacer d'un coup les quatre filtres.
9 : Pose automatiquement les filtres sur le classeur actif, ce qui permet de voir immédiatement les sauvegardes du classeur actif.
10 : Un clic sur un des quatre titres de champ trie la liste par ordre croissant.
11 : Ferme le formulaire. Si des sauvegardes ont été supprimées, le dossier « Sauvegardes_Sentinelle » est actualisé.
12 : Ouvre le classeur de la ligne sélectionnée (pas la sauvegarde) et active la feuille et la plage.


La deuxième méthode consiste à lancer la sentinelle : c'est-à-dire à exécuter le contrôle sur les sauvegardes dont le statut « suivi en sentinelle » est à « Oui ». Dans le menu « Sentinelle », choisir « Lancer la sentinelle ».

Liste des principales situations générant un contrôle non conforme et les actions possibles :
- le contenu de la plage ou d'une feuille a été modifié : ne rien faire, enregistrer les modifications faites comme nouvelle sauvegarde, restaurer la sauvegarde. Notez que si le contrôle ne porte que sur une cellule, son nouveau contenu est affiché dans le titre du formulaire pour information, comme dans l'exemple ci-dessous. Vous pouvez consulter les écarts en cliquant sur le bouton « Voir les écarts » (limités à 1024) ;
- la feuille sur laquelle porte le contrôle n'existe plus : ne rien faire, restaurer la sauvegarde ;
- le classeur est protégé en ouverture par un mot de passe et celui entré n'est pas correct : aucune action possible.

Image non disponible

Liste des principales situations générant une erreur lors de la restauration de la sauvegarde :
- la feuille est protégée par un mot de passe et celui entré n'est pas correct ;
- le classeur est protégé en écriture par un mot de passe et celui entré n'est pas correct ;
- le fichier de sauvegarde du répertoire « Sauvegardes_Sentinelle » a été supprimé.

Un rapport reprend le résultat du contrôle et éventuellement le résultat de l'action demandée.

IV. Les tableaux de données

L'objectif est de rechercher dans le tableau qui mémorise les informations sur les sauvegardes faites si le trio « Chemin + Classeur + Feuille » existe déjà ou non. Si oui, il faut mettre à jour la date de la sauvegarde et sa valeur, sinon il s'agit d'une création.

Comme vu précédemment, si une plage est sauvegardée, il faut supprimer la sauvegarde de la feuille. Inversement, si une feuille est sauvegardée, il faut supprimer les sauvegardes des plages.
Je vous épargne le code que j'avais écrit dans la première version de l'application, pour boucler sur les lignes de la feuille et faire la recherche voulue sur les cellules, puis la mise à jour ou la création, car il est sans intérêt, mais voici le commentaire qu'en a fait Pierre Fauconnier, Responsable Office et Excel chez Developpez.com, lorsqu'il l'a vu :
« Dans MAJSauvegardes je n'aime pas la façon de traiter la plage de données. C'était plus ou moins correct avec EXCEL jusqu'à 2003, mais depuis 2007, on utilise les tableaux de données pour réaliser l'opération. »

À partir de l'onglet « Accueil » puis « Mettre sous forme de tableau », j'ai transformé la plage qui contenait les données en tableau de données, soit la plage « A1:F5 » dans l'exemple ci-dessous.
Puis je l'ai renommé en « T_ Sauvegardes » depuis l'onglet « Outils de tableau / Création » :

Image non disponible

En VBA, les données du tableau de données sont chargées dans une mémoire de type « Range » et sont lues comme s'il s'agissait de cellules, sauf qu'ici la position réelle sur la feuille n'a pas à être gérée, ce qui simplifie l'exercice et offre plus de souplesse. De plus, l'ajout ou la suppression d'une ligne redimensionne automatiquement le tableau de données, donc vous n'avez plus besoin de gérer sa taille.

Voici quelques instructions à connaître pour la manipulation des tableaux de données :
- Set TD = ThisWorkbook.Sheets(Feuille).Range(Tableau) : charge les données dans la mémoire TD, préalablement déclarée en type « Range » ;
- TD.ListObject.DataBodyRange(Ligne, Colonne), ou tout simplement TD(Ligne, Colonne) : permet d'accéder aux données, en lecture/écriture (la ligne 0 correspond à l'en-tête) ;
- TD.ListObject.ListRows.Count : donne la taille du tableau et permet de boucler sur ses éléments ;
- TD.ListObject.ListRows(item).Delete : supprime une ligne du tableau et décale vers le haut les cellules restantes situées sous la ligne supprimée, contrairement à « Rows(Ligne).Delete » qui supprime une ligne entière de la feuille et peut donc causer des dommages collatéraux ;
- TD.ListObject.DataBodyRange.ClearContents : efface toutes les données du tableau TD (pas l'en-tête) ;
- TD.ListObject.Resize Range(TD.CurrentRegion.Address) : redimensionne le tableau TD à sa juste taille, c'est-à-dire, coupe le tableau à la première ligne vide rencontrée ou l'étend à la dernière existante ;
- TD.ListObject.ListRows.Add : ajoute une ligne au tableau vierge TD ;
- TD.ListObject.ShowTotals = True/False : affiche/masque le total de la dernière colonne du tableau TD.

V. Astuces sur les tableaux de données

Vous pouvez mémoriser le contenu d'un tableau de données et restaurer cette mémoire en cas de besoin :

 
Sélectionnez
Dim MémoDonnées As Variant  ' Mémoire pour sauvegarder les valeurs du tableau de données.
Dim MémoAdresse As String   ' Mémoire pour sauvegarder l'adresse de la plage du tableau.
Dim TD As Range             ' Mémoire pour le tableau de données.

' Affecte un tableau de données :
Set TD = Range("Tableau1")

' Mémorise les données du tableau :
MémoDonnées = TD.Value

' Mémorise la plage du tableau :
MémoAdresse = TD.CurrentRegion.Address

... Suite du code ...

' Efface les données existantes et les éventuelles lignes ajoutées :
If TD.ListObject.ListRows.Count > 0 Then TD.ListObject.DataBodyRange.ClearContents

' Redimensionne le tableau à sa taille d'origine :
TD.ListObject.Resize Range(MémoAdresse)

' Restaure les données mémorisées :
TD.ListObject.DataBodyRange.Value = MémoDonnées


Vous pouvez accéder aux données mémorisées en lecture et en écriture.
- MémoDonnées : est une variable à deux dimensions de la forme  MémoDonnées(Ligne, Colonne)
- UBound(MémoDonnées) : indique le nombre de lignes mémorisées.


Trier un tableau de données est un jeu d'enfant (même avec plusieurs critères de tri comme ci-dessous) :

 
Sélectionnez
Dim TD As Range ' Mémoire pour le tableau de données.

' Affecte un tableau de données :
Set TD = Range("Tableau1")

' Configuration du tri:
If TD.ListObject.DataBodyRange Is Nothing = False Then   ' S'il y a des données.
    With TD.ListObject.Sort
        .SortFields.Clear                        ' Efface les anciens critères.
        .SortFields.Add Key:=TD(0, NumColonne1)  ' NumColonne1 = 1re colonne de tri.
        .SortFields.Add Key:=TD(0, NumColonne2)  ' NumColonne2 = 2e colonne de tri.
        .Header = xlYes                          ' Avec en-tête.
        .Apply                                   ' Exécute le tri.
    End With
End If


Remarque sur l'utilisation de TD(Ligne, Colonne) :
- si TD représente un tableau de données alors TD(0,1) contient l'en-tête, et TD(1,1) la première donnée ;
- mais si TD représente une plage ordinaire, TD(0,1) est vide et l'en-tête est en TD(1,1), la première donnée est en TD(2,1) et TD.ListObject revoie Nothing.

VI. Les requêtes SQL

Pour rechercher ou bien mettre à jour une donnée dans un tableau de données, j'utilise les requêtes SQL : vous allez constater dans les lignes qui suivent que c'est très simple et très pratique…

Si vous programmez sous ACCESS les requêtes SQL vous sont familières, pour ceux qui ne connaissent pas voici un bref rappel :

SQL (Structured Query Language) est un langage de programmation qui permet de manipuler une base de données : sélections d'enregistrements, modifications, ajouts, suppressions.

Dans cette application, nous n'utiliserons le SQL que pour faire des sélections, avec « SELECT », soit la syntaxe :
SELECT « nom des colonnes » FROM « nom de la table » WHERE « conditions » ORDER BY « nom des colonnes »

- SELECT « nom des colonnes » : indiquez les champs à sélectionner (entre crochets si leur nom contient un espace), en les séparant par une virgule (l'ordre est libre). Dans notre cas :
SELECT Chemin, Classeur, Feuille, [Date de la sauvegarde], Valeur, Sentinelle FROM…
Ou plus simplement, une étoile permet de sélectionner directement tous les champs :
SELECT * FROM…

- FROM « nom de la table » : pour un tableau EXCEL, le nom de la table s'écrit au format [NomFeuille$PlageCellules], où « PlageCellules » n'est pas en référence absolue et inclut l'en-tête des champs. Soit dans notre exemple :
SELECT * FROM [Sauvegardes$A1:F5]

- WHERE « conditions » : pour restreindre la sélection, vous pouvez ajouter une condition simple ou combinée avec les opérateurs AND et OR comme en VBA. Les données alphanumériques sont à mettre entre simples quotes. Soit dans notre cas pour limiter la sélection aux données où la colonne « Sentinelle » vaut « Non » :
SELECT * FROM [Sauvegardes$A1:F5] WHERE Sentinelle = 'Non'
Les dates sont à mettre entre deux croisillons et au format anglo-saxon (année/mois/jour). Par exemple pour sélectionner les personnes nées à Noël 1971 :
WHERE [Date Naissance] = #1971/12/25#

- ORDER BY « nom des colonnes » : facultatif, permet de trier le résultat de la requête, par ordre ascendant (par défaut) avec la clause ASC ou descendant avec la clause DESC. Il est possible d'ordonner par plusieurs champs, en respectant la syntaxe :
ORDER BY « nom colonne 1 » [ASC, DESC], « nom colonne 2 » [ASC, DESC].

Vous trouverez sur Internet d'autres informations sur les requêtes SQL.
J'aime bien cette adresse : http://www.1keydata.com/fr/sql/syntaxe-sql.php.

Attention, toutes les commandes SQL ne sont pas compatibles avec EXCEL.
Et n'oubliez pas d'installer la référence « Microsoft DAO 3.6 Object Library » dans votre projet : depuis l'éditeur VBA, dans le menu « Outils », « Références », cochez « Microsoft DAO 3.6 Object Library ».

VII. SelectTD - Les requêtes SQL appliquées aux tableaux de données

La fonction « SelectTD » présentée ci-dessous retourne le jeu d'enregistrements (objet Recordset) d'un tableau de données, sélectionnés par une requête SQL. Ses arguments sont :
- TD : un tableau de données, ou une plage avec en-tête, contenu dans « A1:IU65535 » ;
- StrChamps : le ou les champs de l'en-tête qui alimenteront le jeu d'enregistrements (étoile ou vide pour sélectionner tous les champs) ;
- StrSQL : (facultatif) une requête SQL avec ses instructions de conditions (WHERE) et de tri (ORDER BY) ;
- MessageSiErreur : (facultatif) indique s'il faut ou non afficher un message en cas d'erreur ;
- NumErr : (facultatif) alimente le numéro de l'erreur générée par le traitement ou 0 si pas d'erreur.

 
Sélectionnez
'---------------------------------------------------------------------------------------
Public Function SelectTD(TD As Range, StrChamps As String, _
                         Optional ByVal StrSQL As String = "", _
                         Optional MessageSiErreur As Boolean = False, _
                         Optional ByRef NumErr As Long = 0) As DAO.Recordset
'---------------------------------------------------------------------------------------
Dim Db As DAO.Database, Rs As DAO.Recordset

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

' Requête sur le tableau de données passé en argument (ou la plage avec en-tête)
StrSQL = "SELECT " & IIf(StrChamps > "", StrChamps, "*") & " FROM [" & TD.Parent.Name & "$" _
         & TD.CurrentRegion.Address(False, False, xlA1) & "] " & StrSQL

Set Db = DAO.OpenDatabase(TD.Worksheet.Parent.FullName, False, False, "Excel 8.0;HDR=YES;")
Set Rs = Db.OpenRecordset(StrSQL)

' S'il y a des enregistrements concernés:
If Rs.EOF = False Then
    Rs.MoveFirst            ' Replace le pointeur au début du jeu d'enregistrements.
    Set SelectTD = Rs       ' Retourne les enregistrements.
End If

Gest_Err:
NumErr = Err.Number
If Err.Number <> 0 And MessageSiErreur = True Then _
    MsgBox StrSQL & Chr(10) & Chr(13) & Chr(13) & Err.Number & " : " & Err.Description
Err.Clear
End Function
'---------------------------------------------------------------------------------------


- DAO.OpenDatabase : j'utilise la rustique technologie DAO, bien que vouée à être remplacée par la technologie ADO (voir chapitre XVIII), car elle est très simple à manier et à comprendre, et suffit largement pour l'usage que l'on en fait sur les tableaux de données (DAO est compatible avec EXCEL 2016) ;
- TD.Parent.Name : le nom de la feuille est déduit de ce tableau de données ;
- TD.Worksheet.Parent.FullName : le tableau de données passé en argument « TD » peut être dans un classeur différent de celui où est le code, le chemin d'accès étant retrouvé par cette fonction ;
- TD.Address(False, False, xlA1) : permet de retrouver la plage des données en référence non absolue et en incluant l'en-tête des champs. Les titres de l'en-tête doivent être différents les uns des autres ;
- Set SelectTD = Rs : les enregistrements qui répondent à la requête sont retournés dans un Recordset. Ces enregistrements sont accessibles en lecture/écriture. Les modifications sont directement répercutées dans le tableau de données, comme nous allons le voir dans les exemples qui suivent…

VIII. Exemples de requêtes avec la fonction SelectTD

Voici une requête basée sur le tableau de données « T_Personne » de la feuille 1 qui extrait les noms et prénoms des hommes dont le prénom commence par « M » et de plus de 18 ans. Le résultat est classé par ordre croissant des noms et prénoms, et affiché en colonnes « F » et « G » :

 
Sélectionnez
Dim Enr As DAO.Recordset
Dim TD As Range

Set TD = ThisWorkbook.Sheets("Feuil1").Range("T_Personne")
Set Enr = SelectTD(TD, "Nom, Prénom", _
                   "WHERE Age > 18 AND Prénom like 'M*' AND Sexe = 'Masculin' " _
                 & "ORDER BY Nom, Prénom")

If Not Enr Is Nothing Then ' Si un jeu d'enregistrements a été retourné par la requête.
    ThisWorkbook.Sheets("Feuil1").Range("F1").CopyFromRecordset Enr
End If
Image non disponible

La cellule « F5 » est le calcul de l'âge moyen des hommes. Issu du jeu d'enregistrements « Enr.Fields(0) » ce résultat a été obtenu ainsi :

 
Sélectionnez
Dim Enr As DAO.Recordset
Set Enr = SelectTD(Range("T_Personne"), "AVG (Age)", "WHERE Sexe = 'Masculin' ")
Range("F5") = Enr.Fields(0)
  • AVG : calcule la moyenne ;
  • SUM : calcule la somme ;
  • COUNT : compte le nombre d'éléments ;
  • MIM : retourne la valeur la plus petite ;
  • MAX : retourne la valeur la plus grande.

Le mot clé IN permet de sélectionner des éléments parmi une liste de valeurs :
WHERE « nom de colonne » IN ('valeur1', 'valeur2', 'valeur3'…).
Par exemple, ce code renvoie en colonne « F » le nom des personnes dont le prénom est « Hugo » ou « Margaux » :

 
Sélectionnez
Dim Enr As DAO.Recordset
Set Enr = SelectTD(Range("T_Personne"), "Nom", "WHERE Prénom IN('Hugo', 'Margaux')")
If Not Enr Is Nothing Then Range("F1").CopyFromRecordset Enr
Image non disponible

Le mot clé GROUP BY permet de regrouper les données par champ, quand une opération est demandée dans la requête. Cette instruction SQL fait la moyenne de l'âge des hommes et des femmes, et affiche le résultat en triant par ordre croissant :

 
Sélectionnez
Dim Enr As DAO.Recordset
Set Enr = SelectTD(Range("T_Personne"), "Sexe, AVG (Age)", "GROUP BY Sexe ORDER BY AVG (Age)")

If Not Enr Is Nothing Then ThisWorkbook.Sheets("Feuil1").Range("F1").CopyFromRecordset Enr
Image non disponible

Vous pouvez aussi limiter la taille du jeu d'enregistrements retourné avec le mot clé TOP.
Syntaxe : SELECT TOP « nombre d'enregistrements »…
Ici le nom, le prénom et l'âge des trois plus jeunes personnes sont affichés en colonne « F » :

 
Sélectionnez
Dim Enr As DAO.Recordset
Set Enr = SelectTD(Range("T_Personne"), "TOP 3 Nom, prénom, Age", "ORDER BY Age")
If Not Enr Is Nothing Then ThisWorkbook.Sheets("Feuil1").Range("F1").CopyFromRecordset Enr

Astuce : une requête SQL permet aussi de sélectionner les données d'un champ en supprimant les doublons et en triant le résultat par ordre croissant.
C'est très pratique pour alimenter dans un UserForm une liste déroulante des valeurs disponibles.
Syntaxe : SELECT DISTINCT NomDuChamp [WHERE NomDuChamp <> ''] [ORDER BY NomDuChamp].

 
Sélectionnez
Dim Enr As DAO.Recordset
Set Enr = SelectTD(Range("T_Personne"), "DISTINCT Sexe", "WHERE Sexe <> '' ORDER BY Sexe")

If Not Enr Is Nothing Then
    While Enr.EOF = False ' Boucle sur les enregistrements sélectionnés.
        Debug.Print Enr.Fields("Sexe").Value ' Affiche la valeur dans l'éditeur.
        Enr.MoveNext ' Passe à l'enregistrement suivant.
    Wend
End If


Ce code met en majuscules le champ « Prénom » sur toutes les lignes du tableau. Le jeu d'enregistrements étant lié au tableau de données, sa modification se répercute instantanément dans la feuille :

 
Sélectionnez
' Sélectionne tous les enregistrements du champ " Prénom" dans le tableau "T_Personne" :
Dim Enr As DAO.Recordset
Set Enr = SelectTD(Range("T_Personne"), "Prénom") 

' Boucle sur les enregistrements tant que Fin De Fichier (EOF) = Faux :
While Enr.EOF = False  
Enr.Edit                                       ' Passe en mode Modification.
    Enr.Fields(0).Value = Ucase(Enr.Fields(0).Value) ' Modifie la valeur du 1er champ (base 0).
    Enr.Update                                       ' Valide la modification.
    Enr.MoveNext                  ' lit l'enregistrement suivant (EOF = Vrai si plus d'enreg).
Wend                              ' Sortira de la boucle quand tous les enreg seront lus.

Nous allons maintenant passer à un exemple plus compliqué : l'objectif est de restituer, sur la feuille 2, la liste des CDR ayant plusieurs modèles dont le nom commence par « GAF », et leur nombre.

Image non disponible

Vous imaginez bien que la programmation en VBA pour répondre à cette question demande l'écriture de nombreuses lignes de codes.

D'où l'intérêt, encore une fois, de passer par une requête SQL qui fait ça très bien et avec une programmation minimale.

Seule difficulté, il faut connaître l'instruction SQL…

N'étant pas un champion du SQL, pour surmonter cet obstacle je me suis servi d'ACCESS. Concrètement, j'ai créé une table où j'ai collé mes enregistrements. Puis une requête où j'ai défini les critères de sélection :

Image non disponible

En basculant en mode « SQL », j'ai obtenu la requête écrite par ACCESS :

Image non disponible

Il ne reste plus qu'à l'adapter à la fonction SelectTD :

 
Sélectionnez
Dim Enr As DAO.Recordset
Set Enr = SelectTD(Range("A1"), "CDR, Count(Modele)", _
                  "GROUP BY CDR, Modele HAVING (Modele Like 'GAF*' AND Count(Modele)>=2)")
                                              
If Not Enr Is Nothing Then Sheets("Feuil2").Range("A1").CopyFromRecordset Enr
Image non disponible

C'est quand même plus simple comme ça !

IX. La mise à jour des données avec la fonction UpdateTD

La fonction UpdateTD peut simplifier la vie au programmeur en effectuant les deux étapes d'une mise à jour : sélection des enregistrements, boucle sur ces enregistrements pour modifier les champs désirés.
On retrouve les trois mêmes arguments (TD, StrChamps, StrSQL) que pour la fonction SelectTD, puisqu'elle fait appel à cette fonction pour la sélection des enregistrements, auxquels s'ajoute la liste des nouvelles valeurs à appliquer aux champs sélectionnés :
- NvValeur() : la liste des nouvelles valeurs pour les champs sélectionnés dans StrChamps. Les différentes valeurs sont séparées par une virgule. Les champs alphanumériques sont entre guillemets.

La fonction retourne -9 en cas d'erreur, ou le nombre d'enregistrements mis à jour, donc 0 si la sélection des données a été infructueuse.

 
Sélectionnez
'---------------------------------------------------------------------------------------
Public Function UpdateTD(TD As Range, StrChamps As String, _
                         StrSQL As String, ParamArray NvValeur() As Variant) As Long
'---------------------------------------------------------------------------------------
Dim Enr As DAO.Recordset, i As Long, NumErr As Long

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

' Lance la requête de sélection des enregistrements :
Set Enr = SelectTD(TD, StrChamps, StrSQL, True, NumErr)

' Si des enregistrements ont été sélectionnés :
If Not Enr Is Nothing Then
    ' Boucle sur ces enregistrements :
    While Enr.EOF = False
        Enr.Edit ' Passe en mode modification.
        ' Cas particulier des suppressions (recherche un champ au format texte) :
        If NvValeur(0) = "®DeleteTD®" Then
            For i = 0 To Enr.Fields.Count - 1
                If Enr.Fields(i).Type = 10 Then Enr.Fields(i).Value = "®DeleteTD®": Exit For
            Next i
        Else
        ' Boucle sur les champs à mettre à jour :
            For i = LBound(NvValeur()) To UBound(NvValeur())
                Enr.Fields(i).Value = NvValeur(i)
            Next i
        End If
        Enr.Update              ' Valide la modification.
        Enr.MoveNext            ' Passe à l'enregistrement suivant.
        UpdateTD = UpdateTD + 1 ' Compte le nombre d'enregistrements modifiés.
    Wend
End If

Gest_Err:
If Err.Number <> 0 Or NumErr <> 0 Then UpdateTD = -9
Err.Clear
End Function
'---------------------------------------------------------------------------------------


Dans cet exemple nous remplaçons « Margaux CHAPO » dans le tableau des personnes par son frère Hugo âgé de 19 ans :

 
Sélectionnez
Call UpdateTD(Range("T_Personne"), "Prénom, Age, Sexe", _
                "WHERE Nom = 'CHAPO' AND Prénom = 'Margaux' ", "Hugo", 19, "Masculin")


Le cas particulier des suppressions est étudié ci-après.

X. La suppression des données avec la fonction DeleteTD

Si malheureusement il n'est pas possible de supprimer les lignes d'un tableau de données à l'aide d'une requête SQL, nous pouvons nous servir de la fonction UpdateTD pour modifier des données par une « marque » personnelle, par exemple « ®DeleteTD® » (assez personnelle pour ne pas être confondue avec les données de l'utilisateur) puis pour supprimer dans un deuxième temps les lignes ainsi marquées.
Attention, le tableau de données doit donc contenir au moins un champ texte pour accueillir la marque.

La fonction DeleteTD contient les deux arguments suivants :
- TD : un tableau de données ;
- StrSQL : une requête SQL avec ses instructions de conditions (WHERE) qui permet d'identifier les enregistrements à supprimer.

La fonction retourne VRAI si la suppression a été faite, ou FAUX dans le cas contraire.

 
Sélectionnez
'---------------------------------------------------------------------------------------
Public Function DeleteTD(TD As Range, StrSQL As String) As Boolean
'---------------------------------------------------------------------------------------
Dim i As Long, ik As Integer, Conversion As Boolean

' Gestion des erreurs :
On Error GoTo Gest_Err

' Marque les enregistrements (le libellé "®DeleteTD®" est assez personnel pour ne pas être
' confondu avec les données de l'utilisateur et ainsi ne pas supprimer des données par erreur) :
If UpdateTD(TD, "*", StrSQL, "®DeleteTD®") > 0 Then

    ' Si TD est une plage alors la transforme en tableau de données:
    If TD.ListObject Is Nothing Then Set TD = ConvertirPlageEnTD(TD, "", ""): Conversion = True

    ' Supprime dans le tableau les lignes marquées et indique que des suppressions sont faites :
    For i = TD.ListObject.ListRows.Count To 1 Step -1
        For ik = 1 To TD.ListObject.HeaderRowRange.Count
            If TD.ListObject.DataBodyRange(i, ik) = "®DeleteTD®" Then
                TD.ListObject.ListRows(i).Delete
                DeleteTD = True
                Exit For
            End If
        Next ik
    Next i
    
    ' Si TD était une plage alors remet la plage d'origine :
    If Conversion = True Then Call ConvertirTDEnPlage(TD)
    
End If

' Fin du traitement :
Gest_Err:
Err.Clear
'-------------------------------------------------------------------------------

Ce qui permet de supprimer dans le tableau des personnes celles qui ont 18 ans :

 
Sélectionnez
Call DeleteTD(Range("T_Personne"), "WHERE Age = 18")

Vous avez remarqué dans le code des appels pour convertir une plage en tableau de données, et inversement, convertir un tableau de données en plage ordinaire. Nous étudions ces fonctions ci-après.


XI. ConvertirPlageEnTD et ConvertirTDEnPlage

Les fonctions SelectTD et UpdateTD travaillent indifféremment sur des tableaux de données ou des plages ordinaires, mais pas la fonction DeleteTD qui n'est utilisable que sur les tableaux de données.
Il convient donc de se prémunir d'un plantage en convertissant si besoin la plage ordinaire passée en argument en un tableau de données, puis restaurer cette plage à la fin du traitement.

La fonction ConvertirPlageEnTD prend en arguments :
- TD : une plage ordinaire, ou juste la première cellule de cette plage ;
- TDName : (facultatif) le nom à donner au tableau de données, ou vide pour prendre le nom attribué automatiquement par EXCEL ;
- TDStyle : (facultatif) le nom du style du tableau de données, ou * (étoile) pour prendre le style par défaut, ou vide pour n'appliquer aucun style.

La fonction retourne un Range qui représente le tableau de données.

 
Sélectionnez
'---------------------------------------------------------------------------------------
Public Function ConvertirPlageEnTD(TD As Range, _
                                   Optional ByRef TDName As String = "", _
                                   Optional ByRef TDStyle As String = "*") As Range
'---------------------------------------------------------------------------------------
On Error GoTo Gest_Err

' Si le TD existe déjà alors le retourne :
If Not TD.ListObject Is Nothing Then Set ConvertirPlageEnTD = TD

' Si TD ne représente qu'une seule cellule alors étend la plage :
If TD.Count = 1 Then Set TD = TD.CurrentRegion

' Création du TD en attribuant le nom passé ou en prenant celui attribué par EXCEL :
If TDName > "" Then
    Sheets(TD.Parent.Name).ListObjects.Add(xlSrcRange, TD, , xlYes).Name = TDName
Else
    Sheets(TD.Parent.Name).ListObjects.Add xlSrcRange, TD, , xlYes
End If

' Modifie le style s'il ne faut pas prendre celui par défaut, ou pas de style si vide :
If TDStyle <> "*" Then _
    Sheets(TD.Parent.Name).ListObjects(TD.ListObject.Name).TableStyle = TDStyle

' Retourne le nom du tableau de données et son style :
TDName = TD.ListObject.Name
TDStyle = Sheets(TD.Parent.Name).ListObjects(TD.ListObject.Name).TableStyle

' Retourne le tableau de données :
Set ConvertirPlageEnTD = TD

' Fin du traitement :
Gest_Err:
Err.Clear

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

Exemple d'appel :

 
Sélectionnez
Dim TD As Range
Set TD = ConvertirPlageEnTD(Range("A1"))


Inversement, la fonction ConvertirTDEnPlage transforme le tableau de données passé en argument en une plage ordinaire :

 
Sélectionnez
'---------------------------------------------------------------------------------------
Public Function ConvertirTDEnPlage(TD As Range) As Boolean
'---------------------------------------------------------------------------------------
Err.Clear: On Error GoTo Gest_Err

Sheets(TD.Parent.Name).ListObjects(TD.ListObject.Name).TableStyle = "" ' Efface le style.
TD.ListObject.Unlist                                                   ' Efface l'objet.

' Fin du traitement :
Gest_Err:
If Err.Number = 0 Then ConvertirTDEnPlage = True
Err.Clear

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


La fonction retourne VRAI si tout s'est bien passé.

XII. Effacer, redimensionner un tableau de données avec ClearTD et ResizeTD

Pour ajouter une donnée à un tableau de données TD, vous utiliserez TD.ListObject.ListRows.Count + 1 pour connaître la prochaine ligne, puis TD.ListObject.DataBodyRange(Ligne, colonne).Value.
Mais lorsque vous effacez le tableau avec TD.ListObject.DataBodyRange.ClearContents, la taille n'est pas ajustée, et TD.ListObject.ListRows.Count retourne le nombre de lignes d'origine. Le redimensionner avec TD.ListObject.Resize Range(TD.CurrentRegion.Address) génère un tableau vierge où TD.ListObject.ListRows.Count vaut 0.
Il faut alors ajouter une ligne fictive avec TD.ListObject.ListRows.Add en gardant à l'esprit qu'elle est vide. Bref, vous risquez de vous emmêler les pinceaux avec cette gymnastique.
C'est pourquoi je vous conseille d'utiliser les fonctions suivantes :
- ResizeTD pour redimensionner le tableau de données : la fonction retourne le nombre de lignes actives, (0 si vierge), ou -9 si erreur. Ajoutez 1 pour connaître la ligne où insérer une nouvelle donnée ;
- ClearTD pour effacer le tableau de données : la fonction fait appel à ResizeTD pour ajuster le tableau.

 
Sélectionnez
'---------------------------------------------------------------------------------------
Public Sub ClearTD(ByRef TD As Range)
'---------------------------------------------------------------------------------------
On Error Resume Next
TD.ListObject.DataBodyRange.ClearContents ' Efface le contenu du tableau de données.
Call ResizeTD(TD)                         ' Redimensionne le tableau de données.
Err.Clear
End Sub

'---------------------------------------------------------------------------------------
Public Function ResizeTD(ByRef TD As Range) As Long
'---------------------------------------------------------------------------------------
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.

Gest_err:
If Err.Number <> 0 Then ResizeTD = -9
Err.Clear 
End Function
'---------------------------------------------------------------------------------------

XIII. Trier un tableau de données avec la fonction OrderTD

Comme nous l'avons vu, il est facile de trier un tableau de données. La fonction présentée ci-dessous permet de réaliser un tri en passant en arguments le tableau de données et la liste des en-têtes sur lesquels porte le tri. Ces en-têtes doivent être mis entre guillemets et être séparés par une virgule.
Par défaut c'est l'ordre ascendant qui est appliqué. Faites précéder le nom de l'en-tête par le signe inférieur « < » pour appliquer un ordre descendant.
La fonction retourne FAUX en cas d'erreur.

 
Sélectionnez
'---------------------------------------------------------------------------------------
Public Function OrderTD(TD As Range, ParamArray StrChamps() As Variant) As Boolean
'---------------------------------------------------------------------------------------
Dim i As Integer, ik As Integer, Ordre As Long
Dim Clé As String

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

' Configuration du tri s'il y a des données dans le tableau :
If TD.ListObject.DataBodyRange Is Nothing = False Then
    With TD.ListObject.Sort
        .SortFields.Clear
        ' Boucle sur la liste des champs passés en argument :
        For i = LBound(StrChamps()) To UBound(StrChamps())
            ' Récupère l'ordre du classement :
            Ordre = xlAscending
            Clé = StrChamps(i)
            If Left(Clé, 1) = ">" Then 
                Clé = Mid(Clé, 2)
            Else
                If Left(Clé, 1) = "<" Then Clé = Mid(Clé, 2): Ordre = xlDescending
            End If
            ' Recherche la colonne de tri qui correspond à l'en-tête :
            For ik = 1 To TD.ListObject.HeaderRowRange.Count
                If TD(0, ik) = Clé Then .SortFields.Add Key:=TD(0, ik), Order:=Ordre
            Next ik
        Next i
        .Header = xlYes
        .Apply
    End With
End If

' Fin du traitement :
Gest_err:
If Err.Number <> 0 Then OrderTD = False
Err.Clear

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

Ce code trie notre tableau des personnes sur les colonnes « Sexe » (par ordre croissant) et « Age » (par ordre décroissant) :

 
Sélectionnez
Call OrderTD(Range("T_Personne"), "Sexe", "<Age")

XIV. Exemple d'utilisation des tableaux de données et du SQL dans Sentinelle

Après cette étude sur l'utilisation des requêtes SQL avec les tableaux de données, vous comprendrez mieux la fonction ci-dessous, qui fait suite à une critique formulée par Pierre Fauconnier :
« Dans la même procédure, MAJ_Sauvegardes, tu as le bloc d'enregistrement des données. Je préférerais de loin que ce bloc soit isolé dans une procédure qui ne fait que cela. Ici, on se retrouve avec du code spaghetti et il est finalement malaisé de lire le code et de comprendre ce qu'il fait, ce qui amène à des commentaires qui en fait sont superflus si on crée des fonctions qui isolent UNE action et qui portent un nom explicite. Dès lors, plus besoin de commentaires et la possibilité de tester une fonction d'écriture autrement qu'en devant lancer toute la procédure. »

Pour une meilleure lisibilité et une meilleure maintenance du code, « MAJ_Sauvegardes » comporte deux étapes distinctes :
- la création du fichier de sauvegarde, qui est étudiée au chapitre XV ;
- la mise à jour du tableau des sauvegardes, qui s'appuie sur UpdateTD. En cas de création, la ligne où insérer les nouvelles valeurs dans le tableau de données est connue grâce à ResizeTD et les valeurs sont modifiées avec « ListObject.DataBodyRange ».

En cas d'erreur la fonction retourne une chaîne contenant le numéro et le libellé de l'erreur.

 
Sélectionnez
'---------------------------------------------------------------------------------------
Public Function MAJ_Sauvegardes(ByVal StrFeuille As String, ByVal Valeur As String, _
                                Optional Plage As Range) As String
'---------------------------------------------------------------------------------------
Dim StrDate As String, NvLigne As Long

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

' Définition de la date de la sauvegarde :
StrDate = "{" & Now & "}"

' 1re étape, création du fichier de sauvegarde dans le répertoire "\Sauvegardes_Sentinelle\".
' Le nom du fichier est la date du traitement sans les espaces et les barres obliques.
' Retourne une chaîne vide si pas d'erreur ou le code erreur et libellé :
MAJ_Sauvegardes = CréationSauvegardes(ThisWorkbook.Path & "\Sauvegardes_Sentinelle\", _
                                      DateControleEnFichier(StrDate) & ".xlsm", _
                                      StrFeuille, Plage)

' 2e étape (si pas d'erreur à l'étape 1) mise à jour du tableau des données "T_Sauvegardes" :
If MAJ_Sauvegardes = "" Then

    ' Corrige le nom de la feuille pour la mettre au format T_Sauvegardes :
    StrFeuille = "{" & StrFeuille & "}"     ' Nom de la feuille + plage de sélection.
    
    ' Si l'enregistrement existe déjà alors fait sa mise à jour, sinon sa création :
    Dim TD As Range
    Set TD = ThisWorkbook.Sheets("Sauvegardes").Range("T_Sauvegardes")
    
If UpdateTD(TD, "[Date de la sauvegarde], Valeur", _
                    "WHERE [Chemin]='" & ActiveWorkbook.Path & "'" _
                    & " AND [Classeur]='{" & ActiveWorkbook.Name & "}'" _
                    & " AND [Feuille] like '" & StrFeuille & "*'", _
                    StrDate, StrValeur) = 0 Then

        NvLigne = ResizeTD(TD) + 1
        ' Enregistre les nouvelles données:
        TD.ListObject.DataBodyRange(NvLigne, 1).Value = ActiveWorkbook.Path
        TD.ListObject.DataBodyRange(NvLigne, 2).Value = "{" & ActiveWorkbook.Name & "}"
        TD.ListObject.DataBodyRange(NvLigne, 3).Value = StrFeuille
        TD.ListObject.DataBodyRange(NvLigne, 4).Value = StrDate
        TD.ListObject.DataBodyRange(NvLigne, 5).Value = StrValeur
        TD.ListObject.DataBodyRange(NvLigne, 6).Value = "Oui"
    End If
  
End If

' Fin du traitement:
Gest_err:
If Err.Number <> 0 Then MAJ_Sauvegardes = StrFeuille & Chr(13) & Chr(13) & Chr(10) _
                 & Err.Number & " : " & Err.Description ' Libellé de l'erreur.
                 
' Attente si le traitement fait moins d'une seconde, pour éviter de donner le même nom
' de fichier à deux traitements différents :
While StrDate = "{" & Now & "}": DoEvents: Wend

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


Vous trouverez d'autres exemples d'usages de la fonction SelectTD dans l'UserForm « Form_Liste_Sauvegardes ».

Le code source des fonctions SelectTD, UpdateTD, DeleteTD, ConvertirPlageEnTD, ConvertirTDEnPlage, ClearTD, ResizeTD, OrderTD, est contenu dans le module « SQL ».


XV. Sauvegarde d'une feuille ou d'une plage

L'application Sentinelle crée des fichiers pour sauvegarder soit une plage, soit une feuille avec ses éventuelles macros, d'où l'usage du format « .xlsm ».
Ces classeurs sont enregistrés dans le sous-répertoire « Sauvegardes_Sentinelle ».
Leur nom est défini d'après l'heure et la date du traitement. Par exemple « {29/09/2017 11:49:07} » donne le fichier « 29092017114907.xlsm ».

 
Sélectionnez
'---------------------------------------------------------------------------------------
Private Function CréationSauvegardes(StrRépertoire As String, StrFichier As String, _
                                     StrFeuille As String, Optional Plage As Range) As String
'---------------------------------------------------------------------------------------
' Création du fichier de sauvegarde StrFichier dans le répertoire StrRépertoire.
' Retourne : "" si aucune erreur dans le traitement, ou le numéro de l'erreur et son libellé.
'---------------------------------------------------------------------------------------
Dim StrDest As String
Dim Wk As Workbook, Ws As Worksheet
Dim NvWk As Workbook, NvWs As Worksheet

' Création du répertoire de sauvegarde :
On Error Resume Next
MkDir StrRépertoire

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

' Mémorise le classeur et la feuille :
Set Wk = ActiveWorkbook
Set Ws = ActiveSheet

' Création d'un nouveau classeur :
Set NvWk = Workbooks.Add

' Copie la plage ou la feuille source dans le nouveau classeur :
If Plage Is Nothing = True Then
    Wk.Sheets(Ws.Name).Copy before:=NvWk.Sheets(1)
Else
    Wk.Sheets(Ws.Name).Range(Plage.Address).Copy _
            Destination:=NvWk.Sheets(1).Range(Plage.Address)
End If

' Création du nom du fichier destination :
StrDest = StrRépertoire & StrFichier

' Enregistrement du classeur au format xlsm (s'il y a des macros, HasVBProject = True):
NvWk.SaveAs StrDest, xlOpenXMLWorkbookMacroEnabled
NvWk.Close False
Set NvWk = Nothing

' Fin du traitement :
Gest_err:
If Err.Number <> 0 Then CréationSauvegardes = StrFeuille & Chr(13) & Chr(13) & Chr(10) _
                 & Err.Number & " : " & Err.Description ' Libellé de l'erreur.

' Éventuellement, force la fermeture du nouveau classeur sans l'enregistrer :
On Error Resume Next
If NvWk Is Nothing = False Then NvWk.Close False
Err.Clear 
End Function
'---------------------------------------------------------------------------------------

XVI. Rendre une application transparente

L'application Sentinelle doit être « transparente » pour l'utilisateur, c'est-à-dire que seul le menu personnel doit apparaître dans le ruban, et les feuilles doivent rester invisibles.
Dans l'événement « sur ouverture » du classeur (l'objet ThisWorkbook), une boucle permet de sélectionner la fenêtre du classeur et de la masquer. Puis la procédure d'installation du menu est appelée.

 
Sélectionnez
'---------------------------------------------------------------------------------------
Private Sub Workbook_Open()
'---------------------------------------------------------------------------------------
' Evénement déclenché à l'ouverture du classeur.
'---------------------------------------------------------------------------------------
On Error Resume Next
' Boucle sur les fenêtres actives pour masquer la fenêtre de ce classeur :
Dim W As Window
For Each W In Windows
    If W.Caption = ThisWorkbook.Name Then W.Visible = False
Next W

' Lance le menu :
Call MenuSentinelle
End Sub
'---------------------------------------------------------------------------------------


Inversement, lors de la fermeture du classeur, la fenêtre est réaffichée. Les feuilles de l'application sont masquées, sauf la feuille « Accueil » qui indique à l'utilisateur d'activer les macros. Car sans cette validation, l'application Sentinelle ne peut pas fonctionner. Si les macros sont déjà activées, cette feuille sera masquée automatiquement à l'ouverture du classeur comme vu ci-dessus ce qui ne perturbera pas l'utilisateur.

 
Sélectionnez
'---------------------------------------------------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'---------------------------------------------------------------------------------------
' Événement déclenché à la fermeture du classeur
'---------------------------------------------------------------------------------------
On Error Resume Next
' Boucle sur les fenêtres actives pour afficher la fenêtre de ce classeur :
Dim W As Window
For Each W In Windows
    If W.Caption = ThisWorkbook.Name Then W.Visible = True
Next W

' Masque les feuilles de l'application sauf la feuille Accueil :
Dim Ws As Worksheet
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name = "Accueil" Then Ws.Visible = xlSheetVisible Else Ws.Visible = xlSheetVeryHidden
Next Ws

' Enregistre le classeur :
ThisWorkbook.Close Savechanges:=True
End Sub
'---------------------------------------------------------------------------------------

En cas de besoin, l'application peut être affichée en utilisant l'onglet « Affichage », puis « Afficher ».
Pour afficher une feuille masquée avec « xlSheetVeryHidden », le plus simple est de passer par l'éditeur VBA pour modifier la propriété visible de la feuille à « -1 - xlSheetVisible » via la fenêtre des propriétés.


XVII. Un menu personnel évolutif

L'installation d'un menu personnel dans l'onglet « Compléments » du ruban a déjà été étudiée au tome 1, je n'y reviendrai donc pas en détail.
Le code présenté ci-dessous peut être réutilisé pour générer facilement un menu personnel à partir d'un tableau de données.
Voici l'exemple du menu de l'application Sentinelle :

Image non disponible

Par défaut, les données de « T_Menu » de la feuille « Menu » sont utilisées.

 
Sélectionnez
'---------------------------------------------------------------------------------------
Public Sub MenuInstaller(Optional Feuille As String = "Menu", _
                         Optional Tableau As String = "T_Menu", _
                         Optional LimiterUneIcone As Long = -1)
'---------------------------------------------------------------------------------------
' Installe le menu de l'application dans l'onglet Compléments du ruban.
' Par défaut le tableau "T_Menu" de la feuille "Menu" est utilisé.
' Si LimiterUneIcone <> -1 alors n'installe que les éléments de cette icône.
'---------------------------------------------------------------------------------------
Dim MyMenuBar, NewMenu, NewPopup, NvCtrl
Dim TD As Range, i As Long

' Charge en mémoire le tableau qui contient les données pour le menu personnel :
On Error Resume Next
Set TD = ThisWorkbook.Sheets(Feuille).Range(Tableau)

' Boucle sur les lignes du tableau :
For i = 1 To TD.ListObject.ListRows.Count

    ' S'il faut limiter l'installation à une icône ou s'il n'y a pas cette limitation :
    If LimiterUneIcone = -1 _
    Or LimiterUneIcone = Val(TD(i, 4).Value) Then
    
        ' Définit le contrôle NvCtrl suivant le type de contrôle du menu :
        Select Case TD(i, 1).Value
        
            Case "Barre de Commande Contextuelle"
                Set MyMenuBar = Application.CommandBars.ActiveMenuBar
                Set NewMenu = MyMenuBar.Controls.Add(Type:=msoControlPopup, Temporary:=True)
                Set NvCtrl = NewMenu
                
            Case "Barre de Commande Bouton"
                Set MyMenuBar = Application.CommandBars.ActiveMenuBar
                Set NewMenu = MyMenuBar.Controls.Add(Type:=msoControlButton, Temporary:=True)
                Set NvCtrl = NewMenu
                
            Case "Menu Contextuel"
                Set NewPopup = NewMenu.CommandBar.Controls.Add(Type:=msoControlPopup)
                Set NvCtrl = NewPopup
    
            Case "Sous Bouton de commande"
                Set NvCtrl = NewPopup.CommandBar.Controls.Add(Type:=msoControlButton)
                
            Case "Bouton de commande"
                Set NvCtrl = NewMenu.CommandBar.Controls.Add(Type:=msoControlButton)
        
        End Select
        
        ' Initialise les propriétés de ce nouveau contrôle :
        With NvCtrl
            .Caption = TD(i, 2).Value         ' Titre
            .TooltipText = TD(i, 3).Value     ' Info bulle
            .FaceId = TD(i, 4).Value          ' icône
            .OnAction = TD(i, 5).Value        ' Macro à lancer
            .BeginGroup = TD(i, 6).Value      ' Nouveau Groupe
            .DescriptionText = TD(i, 7).Value ' Description
            .Style = msoButtonIconAndCaption  ' Style
        End With
        
    End If

Next i
End Sub 
'---------------------------------------------------------------------------------------


L'option « LimiterUneIcone » permet de n'installer que l'élément qui contient ce numéro d'icône.
Par exemple la barre de commande de type bouton avec l'icône 51 signale un traitement en cours.
Avec le tableau « T_Icone » de la feuille « Menu » suivant :

Image non disponible

L'instruction Call MenuInstaller("Menu", "T_Icone", 51) affiche :

Image non disponible

La suppression d'un menu personnel (une barre de commande de type bouton ou de type contextuel avec ses contrôles) se fait avec la fonction suivante où l'argument représente soit le nom de l'élément (la colonne libellé du tableau) soit sa description :

 
Sélectionnez
'---------------------------------------------------------------------------------------
Public Sub MenuSupprimer(StrNom As String)
'---------------------------------------------------------------------------------------
' Boucle sur les menus pour supprimer le menu passé en argument qui correspond
' à son nom ou à sa description.
'---------------------------------------------------------------------------------------
Dim Cbar As CommandBar, Ctrl

For Each Cbar In Application.CommandBars
    If Cbar.Visible = True Then
        For Each Ctrl In Cbar.Controls
            If Ctrl.Caption = StrNom Or Ctrl.DescriptionText = StrNom Then Ctrl.Delete
        Next Ctrl
    End If
Next Cbar

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

Vous pouvez même mettre de l'animation en affichant des icônes différentes à la manière d'un dessin animé. L'UserForm « Form_Rapport » affiche en boucle, toutes les 1/3 de seconde, une icône issue d'une liste.
Voici le tableau de données « T_Icone » de la feuille « Menu » où seront reprises les icônes 54, 55, 56, 123 :

Image non disponible
 
Sélectionnez
'-------------------------------------------------------------------------------
Dim NumIcone As Long ' Position dans la liste de l'animation.
'-------------------------------------------------------------------------------
Private Sub UserForm_Activate()
'-------------------------------------------------------------------------------
Dim Tps As Double
Dim ListeIcone() As Variant

' Définition de la liste des icônes qui vont former l'animation :
ListeIcone() = Array("54", "55", "56", "123", "56", "55")
NumIcone = UBound(ListeIcone)

' Boucle tant que NumIcone > -1, c'est-à-dire tant que le formulaire n'est pas fermé :
Do

    ' Si 0.3 seconde s'est écoulée :
    If Timer > Tps + 0.3 Then
        Tps = Timer ' Mémorise l'heure actuelle.
        NumIcone = NumIcone + 1 ' Incrémente l'icône dans la liste des icônes.
        If NumIcone > UBound(ListeIcone) Then NumIcone = 0  ' Boucle sur la liste des icônes.
        Call MenuSupprimer("Icone") ' Efface l'icône
        Call MenuInstaller("Menu", "T_Icone", CLng(ListeIcone(NumIcone))) ' Affiche l'icône
    End If

    DoEvents ' Donne la main aux processus en cours.

Loop While NumIcone > -1

' Efface l'icône:
Call MenuSupprimer("Icone")

End Sub

'-------------------------------------------------------------------------------
Private Sub UserForm_Terminate()
'-------------------------------------------------------------------------------
NumIcone = -1 ' Termine la boucle dans UserForm_Activate
End Sub
'-------------------------------------------------------------------------------

Soit l'affichage en boucle de ces icônes :Image non disponible

XVIII. Utiliser la technologie ADO

Dans cette étude des requêtes SQL, nous avons utilisé la technologie DAO qui est aussi rustique que facile à utiliser.
Certains lui préféreront la nouvelle technologie ADO qui, dans notre cas, n'apporte rien de plus.
Cependant j'ai pensé à eux, et aussi aux curieux, en développant un code adapté, qui nécessite d'installer la référence « Microsoft ActiveX Data Objects 6.0 Library ».

La méthode de liaison tardive permet de ne pas référencer cette bibliothèque. Remplacez alors les déclarations « As ADODB.Recordset » par « As Variant ».
L'instanciation d'objets, avec l'instruction « Set Cnn = CreateObject("ADODB.Connection") » est généralement plus lente que l'utilisation d'une bibliothèque, avec l'instruction « Dim Cnn As ADODB.Connection », mais pour l'usage que l'on en fait ici avec les tableaux de données, cette différence de temps de traitement sera négligeable.

Concernant les références « Provider » et « Extended », utilisez :
- soit Microsoft.Jet.OLEDB.4.0 et Excel 8.0 ;
- soit Microsoft.ACE.OLEDB.12.0 et Excel 12.0 (voire Excel 14.0 si vous l'avez).

 
Sélectionnez
'-------------------------------------------------------------------------------
Private Function ADO_ExecuteSQL(TD As Range, StrSQL As String, _
                                Optional MessageSiErreur As Boolean = False, _
                                Optional ByRef NumErr As Long = 0) As ADODB.Recordset
'-------------------------------------------------------------------------------
Dim Cnn As ADODB.Connection
Dim Rs As ADODB.Recordset

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

' Création d'une connexion :
Set Cnn = New ADODB.Connection
Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
         "Data Source=" & TD.Worksheet.Parent.FullName & ";" & _
         "Extended Properties=""Excel 12.0;HDR=Yes"";"

' Exécute une requête SQL sur un jeu d'enregistrements :
Set Rs = New ADODB.Recordset
Rs.Open StrSQL, Cnn, adOpenKeyset, adLockPessimistic, adCmdText

' S'il y a des enregistrements concernés :
If Rs.EOF = False Then
    Rs.MoveFirst              ' Replace le pointeur au début du jeu d'enregistrements.
    Set ADO_ExecuteSQL = Rs   ' Retourne les enregistrements.
End If

' Fin du traitement, libération des mémoires :
Gest_Err:
NumErr = Err.Number
If Err.Number <> 0 And MessageSiErreur = True Then _
    MsgBox StrSQL & Chr(10) & Chr(13) & Chr(13) & Err.Number & " : " & Err.Description

Set Rs = Nothing
Set Cnn = Nothing
Err.Clear

End Function
'-------------------------------------------------------------------------------
 
Sélectionnez
'-------------------------------------------------------------------------------
Public Function ADO_SelectTD(TD As Range, StrChamps As String, _
                             Optional ByVal StrSQL As String = "", _
                             Optional MessageSiErreur As Boolean = False, _
                             Optional ByRef NumErr As Long = 0) As ADODB.Recordset
'---------------------------------------------------------------------------------------
' Sélectionne les données d'un tableau de données EXCEL (ou une plage avec en-tête)
' et alimente ADO_SelectTD des enregistrements correspondants à la requête.
' TD : Le tableau des données (ou la plage avec en-tête). Maxi = A1:IU65535
' StrChamps : Liste des champs (ou * ou vide pour tous).
' StrSQL : Requête SQL avec ses conditions.
' MessageSiErreur : Indique s'il faut ou non afficher un message en cas d'erreur.
' NumErr : Alimente le numéro de l'erreur (0 si pas d'erreur).
'---------------------------------------------------------------------------------------
' Retourne : le jeu d'enregistrements sélectionnés.
'---------------------------------------------------------------------------------------
' Gestion des erreurs :
Err.Clear: On Error GoTo Gest_Err

' Requête sur le tableau de données passé en argument (ou la plage avec en-tête)
StrSQL = "SELECT " & IIf(StrChamps > "", StrChamps, "*") & " FROM [" & TD.Parent.Name & "$" _
         & TD.CurrentRegion.Address(False, False, xlA1) & "] " & StrSQL

' S'il y a des enregistrements concernés alors les retourne :
Set ADO_SelectTD = ADO_ExecuteSQL(TD, StrSQL, MessageSiErreur, NumErr)

' Fin du traitement :
Gest_Err:
NumErr = Err.Number + NumErr
If Err.Number <> 0 And MessageSiErreur = True Then _
    MsgBox StrSQL & Chr(10) & Chr(13) & Chr(13) & Err.Number & " : " & Err.Description

Err.Clear
End Function
'-------------------------------------------------------------------------------
 
Sélectionnez
'-------------------------------------------------------------------------------
Public Function ADO_UpdateTD(TD As Range, _
                             StrChamps As String, _
                             StrSQL As String, _
                             ParamArray NvValeur() As Variant) As Long
'---------------------------------------------------------------------------------------
' Sélectionne les données d'un tableau de données EXCEL (ou une plage avec en-tête)
' puis les modifie avec les informations contenues dans la liste NvValeur.
' TD : Le tableau des données (ou la plage avec en-tête). Maxi = A1:IU65535
' StrChamps : Liste des champs (ou * ou vide pour tous).
' StrSQL : Requête SQL avec ses conditions.
' NvValeur() : liste des nouvelles valeurs à appliquer aux champs sélectionnés
'---------------------------------------------------------------------------------------
' Retourne : -9 si erreur, >=0 le nombre d'enregistrements mis à jour
'---------------------------------------------------------------------------------------
Dim Enr As ADODB.Recordset, i As Integer, EtatScreenUpdating  As Boolean, NumErr As Long

' Gestion des erreurs :
Err.Clear: On Error GoTo Gest_Err
EtatScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' Lance la requête de sélection des enregistrements :
Set Enr = ADO_SelectTD(TD, StrChamps, StrSQL, True, NumErr)

' Si des enregistrements ont été sélectionnés :
If Not Enr Is Nothing Then
    ' Boucle sur ces enregistrements :
    While Enr.EOF = False
        ' Cas particulier des suppressions (recherche un champ au format texte) :
        If NvValeur(0) = "®DeleteTD®" Then
            For i = 0 To Enr.Fields.Count - 1
                If Enr.Fields(i).Type = 202 Then Enr.Fields(i).Value = "®DeleteTD®": Exit For
Autre_Champ:
            Next i
        Else
        ' Boucle sur les champs :
            For i = LBound(NvValeur()) To UBound(NvValeur())
                Enr.Fields(i).Value = NvValeur(i)
            Next i
        End If
        Enr.Update                      ' Valide la modification.
        Enr.MoveNext                    ' Passe à l'enregistrement suivant.
        ADO_UpdateTD = ADO_UpdateTD + 1 ' Compte le nombre d'enregistrements modifiés.
    Wend
End If

' Fin du traitement :
Gest_Err:

' Cas particulier des erreurs lors de la marque "®DeleteTD®" sur des formules :
If Err.Number = -2147217887 Then Err.Clear: Resume Autre_Champ

' Autres cas :
If Err.Number <> 0 Or NumErr <> 0 Then ADO_UpdateTD = -9

Set Enr = Nothing
Err.Clear
Application.ScreenUpdating = EtatScreenUpdating

End Function
'-------------------------------------------------------------------------------
 
Sélectionnez
'-------------------------------------------------------------------------------
Public Function ADO_DeleteTD(TD As Range, StrSQL As String) As Boolean
'---------------------------------------------------------------------------------------
' ATTENTION : TD doit contenir au moins un champ texte.
' Sélectionne les données d'un tableau de données EXCEL puis les supprime.
' TD : Le tableau des données (ou la plage avec en-tête). Maxi = A1:IU65535
' StrSQL : Requête SQL avec ses conditions.
'---------------------------------------------------------------------------------------
' Retourne : VRAI si un moins un enregistrement est supprimé.
'---------------------------------------------------------------------------------------
Dim i As Long, ik As Integer, EtatScreenUpdating As Boolean, Conversion As Boolean

' Gestion des erreurs:
On Error GoTo Gest_Err
EtatScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' Marque les enregistrements (le libellé "®DeleteTD®" est assez personnel pour ne pas être
' confondu avec les données de l'utilisateur et ainsi ne pas supprimer des données par erreur) :
If ADO_UpdateTD(TD, "*", StrSQL, "®DeleteTD®") > 0 Then

    ' Si TD est une plage alors la transforme en tableau de données :
    If TD.ListObject Is Nothing Then Set TD = ConvertirPlageEnTD(TD, "", ""): Conversion = True
    
   ' Supprime dans le tableau les lignes marquées et indique que des suppressions sont faites :
    For i = TD.ListObject.ListRows.Count To 1 Step -1
        For ik = 1 To TD.ListObject.HeaderRowRange.Count
            If TD.ListObject.DataBodyRange(i, ik) = "®DeleteTD®" Then
                TD.ListObject.ListRows(i).Delete
                ADO_DeleteTD = True
                Exit For
            End If
        Next ik
    Next i
    
    ' Si TD était une plage alors remet la plage d'origine :
    If Conversion = True Then Call ConvertirTDEnPlage(TD)
    
End If

' Fin du traitement :
Gest_Err:
Err.Clear
Application.ScreenUpdating = EtatScreenUpdating

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

Ces fonctions sont reprises dans le module « SQL ».

XIX. Fichiers source

Ci-joint les fichiers de l'application Sentinelle :

XX. Conclusion

En suivant les conseils de Pierre Fauconnier, j'ai revu ma copie pour vous présenter un code source plus en conformité avec les bonnes pratiques de programmation.

Plus particulièrement les requêtes SQL appliquées aux tableaux de données.

Curieusement cette technique est peu documentée sur Internet, et c'est bien dommage, car elle permet une programmation rapide, facile, et remarquablement efficace, pour la lecture et la manipulation des données :
- vous n'avez plus besoin de vous soucier des coordonnées des tableaux, qui peuvent donc être déplacés librement ;
- le nom des champs peut être passé dans le jeu d'enregistrements, comme ici : Enr.Fields(« Date de la sauvegarde »).Value, les colonnes peuvent donc bouger sans que cela influence votre code VBA. Vous pouvez aussi utiliser l'indice du jeu d'enregistrements « Enr.fields(i).Value » ou « i » correspond au énième champ déclaré dans l'argument « StrChamps » de la fonction « SelectTD », en commençant par l'indice 0 ;
- fini les boucles sur les différentes lignes des tableaux à la recherche des données désirées ;
- et fini aussi l'écriture d'une nouvelle procédure à chaque nouveau cas de figure, car les requêtes SQL couvrent (presque) tous les besoins de sélection.

Pour ma part c'est décidé, terminé les prises de tête pour la gestion des données, dorénavant je n'utiliserai plus que les tableaux de données et le SQL avec la fonction SelectTD et ses petites sœurs dans mes programmes.

Avec une seule restriction : les données doivent se trouver dans une plage comprise entre A1 et IU65535, soit l'équivalant des feuilles de calculs EXCEL 97. Il semblerait que les ingénieurs du VBA aient oublié que depuis 2007, les feuilles ont 1 048 576 lignes. Gageons que cette lacune sera corrigée dans les prochaines versions du VBA.

Vous trouverez d'autres trucs et astuces dans le tome 6, qui sera le dernier mémento de cette série.

N'oubliez pas la FAQ EXCEL qui est une mine d'or : https://excel.developpez.com/faq/


À bientôt et bonne programmation.

Laurent OTT. 2017.

XXI. Remerciements

Je tiens à remercier Pierre Fauconnier, Gaby277, Lolo78, pour la relecture technique et pour leurs nombreux conseils, ainsi que Guillaume Sigui pour la mise au gabarit Developpez.com et Claude Leloup, pour la correction orthographique.

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2017 Laurent OTT. Aucune reproduction, même partielle, ne peut être faite de ce site ni de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts. Droits de diffusion permanents accordés à Developpez LLC.