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

Des fonctions génériques en VBA pour gérer facilement les tableaux structurés d’Excel

Laurent Ott

Dans cet article vous allez découvrir des fonctions en VBA pour gérer les tableaux structurés d’Excel. Ces fonctions couvrent l’essentiel des besoins du programmeur et lui simplifient la vie, car il n’est pas nécessaire de connaître les subtilités de l’objet « ListObject » pour les utiliser.

Vous pouvez déposer vos commentaires dans cette discussion.

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

- Auteur : Laurent Ott

- Parution : 14 février 2022

- Mise à jour : 17 décembre 2025

- 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

- Des fonctions en VBA pour générer des courriels par les balises HTML

- MsgBox_Perso : une boîte de message personnalisée

- Utiliser une collection ArrayList à plusieurs dimensions

- Fonctions en VBA pour gérer de gros volumes de données

- Les cryptosystèmes RSA et AES-256

Sommaire

- I. Introduction

- II. Concevoir un tableau structuré

- II-A. TS_SiErreur

- II-B. TS_ConvertirPlageEnTS

- II-C. TS_CréerUnTableau

- II-D. TS_SupprimerLeTableau

- II-E. TS_IndexColonne

- II-F. TS_IndexLigne

- II-G. TS_ChangerLibellé

- II-H. TS_EffacerUneLigne

- II-I. TS_EffacerToutesLignes

- II-J. TS_AjouterUneLigne

- II-K. TS_SupprimerUneLigne

- II-L. TS_SupprimerPlusieursLignes

- II-M. TS_SupprimerToutesLignes

- II-N. TS_SupprimerLignesVisibles

- II-O. TS_SupprimerLignesMasquées

- II-P. TS_SupprimerDoublons

- II-Q. TS_AjouterUneColonne

- II-R. TS_SupprimerUneColonne

- II-S. TS_DéplacerUneColonne

- II-T. TS_AfficherOuMasquerColonne

- II-U. TS_LargeurColonne

- II-V. TS_EffacerUneColonne

- II-W. TS_OptionsStyle

- II-X. TS_DéfinirTotaux

- II-Y. TS_FormatColonne

- II-Z. TS_Aligner

- III. Trier, filtrer les données d’un tableau structuré

- III-A. TS_TrierUneColonne

- III-B. TS_EffacerTri

- III-C. TS_Filtres_Existe

- III-D. TS_Filtres_Poser

- III-E. TS_Filtres_Effacer

- III-F. TS_Filtres_Mémoriser

- III-G. TS_Filtres_Restaurer

- III-H. TS_CouleurLigneChangeValeur

- IV. Obtenir des informations sur les données d’un tableau structuré

- IV-A. TS_Nombre_Lignes

- IV-B. TS_Nombre_Colonnes

- IV-C. TS_ValeurColonne

- IV-D. TS_InfoCellule

- V. Rechercher, sélectionner, modifier les données d’un tableau structuré

- V-A. TS_Rechercher

- V-B. TS_RechercherVisible

- V-C. TS_Remplacer

- V-D. TS_Sélectionner

- V-E. TS_Range

- V-F. TS_ModifCellule

- V-G. TS_ForcerValeurColonne

- VI. Importer, exporter des données d’un tableau structuré

- VI-A. TS_ImporterDonnées (version importation)

- VI-B. TS_ImporterDonnées (version exportation)

- VI-C. TS_ExporterEnFichier

- VI-D. TS_EnregistrerDansAccess

- VI-E. TS_ImporterDepuisAccess

- VI-F. TS_RequeteBaseAccess

- VI-G. TS_CopierUneColonne

- VI-H. TS_CopierValeurColonne

- VI-I. TS_CopierUneLigne

- VI-J. TS_CopierTableau

- VI-K. TS_CopierUnTableau

- VI-L. TS_MémoriseTableau

- VI-M. TS_ImporterDepuisClasseur

- VI-N. TS_ImporterDepuisClasseurAvecSQL

- VI-O. TS_ImporterFichierTexteAvecSQL

- VI-P. TS_ImporterDepuisFichierHTML

- VII. Vos contributions

- VII-A. TS_CelluleActive

- VII-B. TS_ObjetInserer

- VII-C. TS_ObjetSupprimer

- VII-D. TS_ObjetNom

- VII-E. TS_ObjetRenommer

- VII-F. TS_ModifierListeValidation

- VII-G. TS_ListeSansDoubon

- VII-H. TS_ValeurUnique

- VII-I. TS_ComparerDeuxTableaux

- VII-J. TS_AlimenterColonne

- VII-K. TS_ComboBox

- VII-L. TS_RangeDansClasseur

- VII-M. TS_OuvrirClasseur et TS_FermerClasseur

- VII-N. TS_AES

- VII-O. TS_SolveurSomme

- VII-P. TS_LierMacroSurTitre

- VII-Q. TS_FiltrerColonneActive

- VIII. Conclusion

- IX. Remerciements

- X. Le fichier joint

- XI. Exemples d'utilisation de fonctions

- XI-A. Alimenter un tableau d'une liste sans doublon

- XI-B. Alimenter le tableau structuré « TS_Fratries » des fratries

- XII. Annexe 1 – Les requêtes SQL en VBA sur les tableaux structurés

- XII-A. Présentation des requêtes SQL

- XII-B. TS_RequeteSQL

- XII-C. TS_ModifierSQL

- XII-D. TS_FormatSQL

- XIII. Annexe 2 – Fusionner deux fichiers PDF en VBA

- XIV. Annexe 3 – Contrôler la validation des données

- XV. Annexe 4 – Gestion des statuts

- XV-A. Annexe 4A – Gestion des statuts pour accélérer les traitements

- XV-B. Annexe 4B – Une barre de progression qui s’affiche dans la barre d’état

- XVI. Annexe 5 – les variables publiques et les énumérations du module

I - Introduction

Excel, principalement depuis sa version 2010, propose une gestion des données sous forme de tableaux dits « tableaux structurés » (ou « Table », « Tableau », « Tableau de données »), une technologie bien plus puissante et ergonomique que les classiques « plages de données ».

Pierre Fauconnier y consacre un tutoriel destiné aux utilisateurs « Apprendre à utiliser les tableaux structurés Excel : création, manipulations et avantages » que je vous recommande de lire si vous n’utilisez pas encore les tableaux structurés.

En résumant les avantages que les tableaux structurés procurent aux utilisateurs nous pouvons citer, entre autres :

- un large éventail de styles automatiques de présentation permettant une mise en surbrillance une ligne sur deux pour faciliter la lecture ;

- des formules plus simples à concevoir et à relire, car elles incluent le nom des colonnes auxquelles elles font référence ;

- une recopie automatique des formules à l’ajout d’une nouvelle ligne ;

- la possibilité d’inclure très facilement une ligne de totaux ou inversement de la masquer ;

- la possibilité de déplacer le tableau sur la feuille de calcul d’un simple glisser/déposer ou de déplacer les colonnes à l’intérieur du tableau pour adapter la présentation à ses besoins.

Cette nouvelle technologie connaît donc logiquement un engouement auprès des utilisateurs, mais aussi auprès des développeurs, que ce soit par choix ou par nécessité.

Par choix, car comme nous le verrons dans cette documentation, un tableau structuré se gère un peu comme une base de données avec des noms de colonnes uniques et une plage déterminée.
Ainsi, dans de nombreux domaines, gérer les données dans un tableau structuré est plus simple que dans une plage de données classique.
Par exemple, nous accéderons à une donnée en utilisant soit le nom de sa colonne soit son numéro, et le numéro de sa ligne, sans avoir à nous soucier de savoir où elle est positionnée physiquement sur la feuille.

Par nécessité, car les programmeurs se retrouvent de plus en plus souvent face à des tableaux structurés que les utilisateurs, à juste titre, plébiscitent.

En complément au tutoriel précité, celui-ci s’adresse aux programmeurs débutants ou confirmés en proposant des fonctions génériques pour gérer les tableaux structurés en VBA.

Ces fonctions couvrent l’essentiel des besoins du programmeur et lui simplifient la vie, car il n’est pas nécessaire de connaître les subtilités de l’objet « ListObject » pour les utiliser.

Les fonctions sont regroupées en cinq thèmes :

- concevoir un tableau structuré ;

- trier, filtrer les données ;

- obtenir des informations sur les données ;

- rechercher, sélectionner, modifier les données ;

- importer, exporter des données.

Toutes les fonctions présentées ont en commun :

- de renvoyer une valeur permettant d’identifier si le traitement demandé s’est déroulé correctement ou non ;

- en cas d’erreur de traitement, d’alimenter les variables publiques TS_ErrNumber et TS_ErrDescription, déclarées en en-tête du module « TS » du fichier joint, avec respectivement le code de l’erreur Err.Number et sa description Err.Description et d'afficher ou non une boîte de dialogue (nous détaillerons cela avec l'étude de la fonction TS_SiErreur) ;

- d’être préfixées « TS_ » pour mieux les identifier.

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 ».

Les codes de cette documentation ont été réalisés avec Excel 2016 version 32 bits sous Windows 10. Ils sont compatibles avec la version 64 bits d'Excel 365.

II - Concevoir un tableau structuré

Les différentes fonctions de ce chapitre sont consacrées à la conception d’un tableau structuré.
Cela va de sa création à la gestion de ses options, en passant par l’effacement, l’ajout ou la suppression de lignes et colonnes.
Mais avant tout nous allons étudier comment sont gérées les erreurs dans les différentes fonctions.

II-A - TS_SiErreur

Les différentes fonctions que nous allons étudier ci-après renvoient pratiquement toutes une valeur d'exécution permettant d'identifier si le traitement s'est déroulé correctement, généralement True si tout s’est bien passé ou False ou -1 dans le cas contraire.

Dans tous les cas, une erreur de traitement alimente les variables publiques TS_ErrNumber et TS_ErrDescription avec respectivement le code de l’erreur Err.Number et sa description Err.Description.

Le programmeur peut donc savoir si une erreur s'est produite en analysant la valeur renvoyée par la fonction appelée, et afficher s'il le souhaite une boîte de dialogue pour décrire cette erreur en utilisant les variables TS_ErrNumber et TS_ErrDescription.
Ce qui peut être lourd à gérer dans une application faisant de nombreux appels aux fonctions comme il m'a été fait remarqué dans la discussion liée à cette documentation.

J’ai donc modifié la gestion des erreurs du module « TS » en conséquence et désormais trois possibilités sont offertes par la fonction TS_SiErreur pour paramétrer la façon dont vous souhaitez gérer les erreurs, en sélectionnant l’une des options suivantes dans son argument :

- TS_Générer_Erreur : (par défaut) la fonction renvoie l'erreur à la procédure appelante. Si celle-ci possède un gestionnaire d'erreurs validé, il est activé afin de gérer l'erreur, sinon le traitement est interrompu ;

- TS_MsgBox_Erreur : l’erreur n’est pas renvoyée à la fonction appelante mais une boîte de message signale l’erreur, et la fonction revoie un code d’erreur (False ou -1) ;

- TS_Ignorer_Erreur : l’erreur est « ignorée », seul le code d'erreur renvoyé (False ou -1) permet de savoir qu’une erreur s’est produite.

Remarque : la fonction TS_SiErreur peut être appelée n'importe où dans votre programme et autant de fois que vous le désirez.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_SiErreur(TS_Gestion_Err As Enum_Gestion_Err)
'------------------------------------------------------------------------------------------------
' Paramètre comment les erreurs doivent être gérées dans les fonctions de ce module.
'------------------------------------------------------------------------------------------------
' TS_Gestion_Err : Indique comment traiter une erreur, suivant l'énumération Enum_TS_Gestion_Err:
'    TS_Générer_Erreur = (par défaut) renvoie l'erreur à la procédure appelante. Si elle possède un
'                     gestionnaire d'erreurs validé, il est activé afin de gérer l'erreur, sinon
'                     le traitement est interrompu.
'    TS_MsgBox_Erreur = Affiche une boîte de message indiquant l'erreur et continue le traitement, mais
'                    la fonction renvoie un code d'erreur qui lui est propre (généralement False ou -1).
'    TS_Ignorer_Erreur = Ignore l'erreur (la fonction renvoie un code d'erreur, généralement False ou -1).
'------------------------------------------------------------------------------------------------
TS_Méthode_Err = TS_Gestion_Err
End Function
'------------------------------------------------------------------------------------------------

Exemple avec un cas (théorique) où l’utilisateur sélectionne un fichier contenant un tableau structuré nommé « Tableau1 » à importer dans le classeur actif. Puis les données sont mises en forme et triées sur la colonne "Prenom" :

L’instruction Call TS_SiErreur(TS_Ignorer_Erreur) permet d’ignorer les erreurs du module « TS ». Ainsi la fonction TS_ImporterDepuisClasseur renvoie False en cas d’erreur sans bloquer la suite du traitement. L’utilisateur s’est simplement trompé de fichier, on lui demande s’il veut en sélectionner un autre.
On pourrait aussi utiliser On Error Resume Next avant l’appel de la fonction puis restaurer le gestionnaire d’erreur On Error GoTo Gest_Err après. C’est à vous de choisir ce que vous préférez.

L’instruction Call TS_SiErreur(TS_MsgBox_Erreur) affiche un message en cas d’erreur. Ici rien n’est bloquant, l’utilisateur a peut-être renommé la colonne « Date » en « Dates », peu importe car elle ne sera pas utilisée dans la suite du traitement, un message signale simplement cette anomalie (qu’il conviendra de corriger).

L’instruction Call TS_SiErreur(TS_Générer_Erreur) branchera la procédure à l’étiquette Gest_Err en cas d’erreur. Si l’utilisateur a renommé la colonne « Prenom » en « Prénom » l’erreur est critique car cette colonne est utilisée pour diverses opérations, donc la procédure est terminée et un message affiche l’erreur.

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Dim Fichier As String
Dim Moyenne As Double
Set Tableau = Range("Tableau1")

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

' Ne bloque pas le traitement en cas d'erreur, c'est jusque que l'utilisateur
' a sélectionné le mauvais fichier:
Call TS_SiErreur(TS_Ignorer_Erreur)

Do
' Sélectionne un fichier Excel:
Fichier = Application.GetOpenFilename("Fichiers Excel,*.xls*")
' Importe les données dans un tableau structuré:
If TS_ImporterDepuisClasseur(Fichier, "", "Tableau1", Tableau, TS_RemplacerDonnées, "") = False Then
' Si ce n'est pas le bon fichier alors le signaler:
If MsgBox("Voulez-vous sélectionner un autre fichier ?", vbQuestion + vbYesNo, _
"Ce n'est pas le bon fichier") = vbNo Then Exit Sub
Fichier = ""
End If
Loop While Fichier = ""

' Génère un message en cas d'erreur mais continue la traitement:
Call TS_SiErreur(TS_MsgBox_Erreur)

' Format Numérique et format date:
Call TS_FormatColonne(Tableau, "Note", "0.0", True)
Call TS_FormatColonne(Tableau, "Date", "dd/mm/yyyy")

' Branchement à l'étiquette "Gest_Err" si une erreur se produit dans les traitements
' du tableau:
Call TS_SiErreur(TS_Générer_Erreur)

' Trie la colonne "Prenom":
Call TS_TrierUneColonne(Tableau, "Prenom", xlSortOnValues, xlAscending, True)

' Compte la moyenne des notes:
Moyenne = TS_ValeurColonne(Tableau, "Note", xlTotalsCalculationAverage, False)

' Autres traitements:

' ...

' Gestion des erreurs:
Gest_Err:
If Err.Number <> 0 Then MsgBox "Erreur dans la fonction : " & Err.Source & vbCrLf & vbCrLf _
& Err.Number & " : " & Err.Description, _
vbCritical, "Exemple"
Err.Clear
End Sub
'------------------------------------------------------------------------------------------------

II-B - TS_ConvertirPlageEnTS

La fonction TS_ConvertirPlageEnTS convertit une plage de données classique en un tableau structuré.

Ses arguments sont :

- TD : la plage (de type Range) qui représente la plage de données à convertir ou tout simplement la première cellule haut/gauche de cette plage, car la plage sera étendue automatiquement ;

- Nom : (facultatif) le nom à donner au tableau structuré généré. Si l’argument n’est pas renseigné, le tableau prendra le nom attribué automatiquement par Excel ;

- Style : (facultatif) le nom du style du tableau structuré. Si l’argument n’est pas renseigné, le style par défaut sera appliqué. Si l’argument est vide, alors le tableau sera sans style ;

- AvecEntete : (facultatif) une valeur de l’énumération XlTotalsCalculation qui indique si la première ligne contient des en-têtes, soit l'une des valeurs suivantes :
- xlYes : (valeur par défaut) la plage contient des en-têtes,
- xlNo : la plage ne contient pas d'en-tête et Excel les rajoute,
- xlGuess : Excel détecte automatiquement si la plage contient ou non des en-têtes.

La fonction renseigne :

- Nom : le nom donné au tableau structuré, ce qui peut être utile si l’argument n’avait pas été renseigné pour connaître le nom attribué par Excel ;

- Style : le nom du style du tableau structuré, ce qui peut également être utile si l’argument n’avait pas été renseigné.

La fonction renvoie : un Range qui représente la plage du tableau structuré généré.

Exemple pour convertir la plage de données située en « A1 » de la feuille « Feuil3 » en un tableau structuré qui sera nommé « TS_Eleves » et de style « clair 13 » (ici la plage de type Range renvoyée n’est pas utilisée, mais nous étudierons des exemples où elle le sera, c’est pourquoi j’ai souhaité la représenter) :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = TS_ConvertirPlageEnTS(TD:=Sheets("Feuil3").Range("A1"), Nom:="TS_Eleves", _
Style:="TableStyleLight13", AvecEntete:=xlYes)
End Sub
'------------------------------------------------------------------------------------------------

Remarque : dans le code de cet exemple (et dans plusieurs autres de cette documentation), les arguments sont nommés pour vous faciliter la lecture, un appel plus court reste évidemment possible :
Set Tableau = TS_ConvertirPlageEnTS(Sheets("Feuil3").Range("A1"), "TS_Eleves", "TableStyleLight13")

Ou puisque le renvoi de la fonction n’est pas utilisé :
Call TS_ConvertirPlageEnTS(Sheets("Feuil3").Range("A1"), "TS_Eleves", "TableStyleLight13")

Ou encore (sans l’instruction Call) :
TS_ConvertirPlageEnTS Sheets("Feuil3").Range("A1"), "TS_Eleves", "TableStyleLight13"

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ConvertirPlageEnTS(TD As Range, _
Optional ByRef Nom As String = "", _
Optional ByRef Style As String = "*", _
Optional AvecEntete As XlYesNoGuess = xlYes) As Range
'------------------------------------------------------------------------------------------------
' Transforme une plage classique en un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TD : La plage concernée (ou la cellule haut gauche) du tableau de données.
' Nom : Le nom à donner au tableau ou vide pour prendre le nom attribué par EXCEL.
' Style : Le style ou * pour le style par défaut ou vide pour aucun style.
' AvecEntete : Indique si la première ligne contient des en-têtes :
'              xlYes : la plage contient des en-têtes;
'              xlNo : la plage ne contient pas d'en-tête et Excel les rajoute;
'              xlGuess : Excel détecte automatiquement si la plage contient ou non des en-têtes.
'------------------------------------------------------------------------------------------------
' Renvoie : La plage Range qui représente la plage du Tableau Structuré créé.
'------------------------------------------------------------------------------------------------
' Exemple :
' Dim TS As Range
' Set TS = ConvertirPlageEnTS(Range("K3"))
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear

' Si le TD n'existe pas déjà alors le créer:
If TD.ListObject Is Nothing Then

' 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 Tableau Structuré en attribuant le nom passé ou en prenant celui attribué par EXCEL:
If Nom > "" Then
TD.Parent.ListObjects.Add(xlSrcRange, TD, , AvecEntete).Name = Nom
Else
TD.Parent.ListObjects.Add xlSrcRange, TD, , AvecEntete
End If

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

End If

' Renseigne le nom du Tableau Structuré et son style:
Nom = TD.ListObject.DisplayName
Style = TD.Parent.ListObjects(TD.ListObject.Name).TableStyle

' Renvoie la plage du Tableau Structuré:
Set TS_ConvertirPlageEnTS = TD

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ConvertirPlageEnTS", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ConvertirPlageEnTS"
End If
Err.Clear

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

II-C - TS_CréerUnTableau

La fonction TS_CréerUnTableau crée un tableau structuré en utilisant les informations passées en arguments.

Ses arguments sont :

- Plage : la plage (de type Range) qui représente la première cellule haut/gauche où sera placé le tableau structuré ;

- Titres : les noms pour l'en-tête des colonnes, de format Array() c'est-à-dire entre guillemets et séparés par une virgule (voir l’exemple). Si le tableau n’a qu’une colonne, le titre peut être passé sous la forme String ;

- Nom : (facultatif) le nom à donner au tableau structuré créé. Si l’argument n’est pas renseigné, le tableau prendra le nom attribué automatiquement par Excel ;

- Style : (facultatif) le nom du style du tableau structuré. Si l’argument n’est pas renseigné, le style par défaut sera appliqué. Si l’argument est vide, alors le tableau sera sans style.

La fonction renseigne les arguments :

- Nom : le nom donné au tableau structuré (utile si l’argument n’avait pas été renseigné) ;

- Style : le nom du style du tableau structuré (utile si l’argument n’avait pas été renseigné).

La fonction renvoie : un Range qui représente la plage du tableau structuré créé.
Si un tableau existait déjà à l’emplacement demandé, alors la fonction renvoie la plage de ce tableau.

Exemple pour créer un tableau structuré en « A1 » sur la feuille « Feuil3 » qui sera nommé « TS_Eleves » et de style « clair 13 » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = TS_CréerUnTableau(Plage:=Sheets("Feuil3").Range("A1"), _
Titres:=Array("Nom", "Prénom", "Note"), _
Nom:="TS_Eleves", _
Style:="TableStyleLight13")
End Sub
'------------------------------------------------------------------------------------------------

Remarque : le tableau est créé avec une ligne qui s'affiche dessous, mais reste vierge, la saisie peut commencer. En VBA, le tableau sera initialisé lors de l’ajout d’une première ligne, voir la fonction TS_AjouterUneLigne.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_CréerUnTableau(Plage As Range, _
Titres As Variant, _
Optional ByRef Nom As String = "", _
Optional ByRef Style As String = "*") As Range
'------------------------------------------------------------------------------------------------
' Création d'un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Plage : La plage du tableau (ou juste la cellule Haut Gauche du tableau).
' Titres : Les titres pour l'en-tête, de format Array() c'est-à-dire entre guillemets et séparés par une virgule.
'          S'il n'y a qu'une colonne à créer on peut la passer de la forme String (voir l'exemple).
' Nom : Le nom à donner au tableau ou vide pour prendre le nom attribué par EXCEL.
' Style : Le nom Excel du style ou * pour le style par défaut ou vide pour aucun style.
'------------------------------------------------------------------------------------------------
' Renvoie : La plage Range qui représente la plage du Tableau Structuré créé.
'------------------------------------------------------------------------------------------------
' Exemple d'utilisation:
' Dim TS As Range
' Set TS = TS_CréerUnTableau(Range("A1"), Array("Nom", "Prénom", "Note"), "Tableau_Eleves")
' S'il n'y a qu'un seul titre le Array n'est pas nécessaire:
' Set TS = TS_CréerUnTableau(Range("A1"), "Nom", "Tableau_Eleves")
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Si le tableau existe déjà alors le renvoyer:
If Not Plage.ListObject Is Nothing Then
Nom = Plage.ListObject.DisplayName
Style = Plage.ListObject.TableStyle
Set TS_CréerUnTableau = Range(Plage.ListObject)
Else
' Affiche les titres:
If IsArray(Titres) = True Then
Plage.Resize(1, UBound(Titres) + 1).Value = Titres
Else
Plage.Value = Titres
End If
' Conversion de la plage en un Tableau Structuré:
Set TS_CréerUnTableau = TS_ConvertirPlageEnTS(Plage, Nom, Style)
End If

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_CréerUnTableau", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_CréerUnTableau"
End If
Err.Clear

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

II-D - TS_SupprimerLeTableau

La fonction TS_SupprimerLeTableau supprime le tableau structuré passé en argument.

Son argument est :

- TS : la plage (de type Range) qui représente le tableau structuré à supprimer.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour supprimer le tableau structuré nommé « TS_Eleves » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Call TS_SupprimerLeTableau(Range("TS_Eleves"))
End Sub
'------------------------------------------------------------------------------------------------

Le nom d'un tableau structuré est unique dans un classeur. Il n'est donc pas nécessaire d'indiquer la feuille où il se trouve dans l'argument passé à la fonction car Excel sait l'identifier, sauf (la nuance est importante) s'il n'est pas dans le classeur actif. Dans ce cas il faut effectivement indiquer la feuille où il se trouve.
Pour cette documentation tous les tableaux structurés sont dans le classeur actif.

En pratique, pour simplifier l'emploi des fonctions, privilégiez l'usage d'une variable qui fait référence au tableau structuré.
Cela permet de ne déclarer la plage du tableau qu'une seule fois et donc de faciliter la maintenance du code.

Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_SupprimerLeTableau(Tableau)

Certain vont préférer passer en argument la plage du tableau sous sa forme « simplifiée » (c'est-à-dire le nom du tableau mis entre crochets) ce qui donne :
Call TS_SupprimerLeTableau([TS_Eleves])

Chacun a ses habitudes de programmation et je vous laisse libre de faire comme bon vous semble.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_SupprimerLeTableau(TS As Range) As Boolean
'------------------------------------------------------------------------------------------------
' Suppression d'un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear

' Supprime le tableau:
TS.ListObject.Delete
TS_SupprimerLeTableau = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_SupprimerLeTableau", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_SupprimerLeTableau"
End If

Err.Clear

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

II-E - TS_IndexColonne

La fonction TS_IndexColonne renvoie le numéro de la colonne passée en argument, qu’elle soit passée d’après son nom ou sa position. Cette fonction sera très utilisée par la suite, car nous accéderons à une colonne d’un tableau structuré principalement d’après son nom.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée.

La fonction renvoie : le numéro de la colonne concernée ou -1 en cas d’erreur.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_IndexColonne(TS As Range, Colonne As Variant) As Long
'------------------------------------------------------------------------------------------------
' Recherche le numéro de la colonne d'un tableau structuré.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : le numéro de la colonne ou le nom de la colonne.
'           Si vide ou 0 alors renvoie le numéro de la dernière colonne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : Le numéro de la colonne dans le tableau, ou -1 si erreur.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' S'il faut traiter la dernière colonne:
If Colonne = "" Or Colonne = 0 Then Colonne = TS.ListObject.ListColumns.Count

' Retrouve le numéro de la colonne si c'est le nom qui est passé en argument,
' une erreur des déclenchée si le nom n'existe pas:
If TypeName(Colonne) = "String" Then Colonne = TS.ListObject.ListColumns(Colonne).Index

' Contrôle la cohérence de la colonne passée en argument:
If Colonne < 0 Or Colonne > TS.ListObject.ListColumns.Count Then
TS_IndexColonne = -1
Else
TS_IndexColonne = Colonne
End If

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Or TS_IndexColonne = -1 Then
TS_IndexColonne = -1
TS_Err_Description = "La colonne [" & Colonne & "] n'est pas inclue dans le tableau."
End If
Err.Clear

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

II-F - TS_IndexLigne

La fonction TS_IndexLigne contrôle la cohérence de la ligne passée en argument.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Ligne : le numéro de la ligne concernée. Si ce nombre est zéro, alors la dernière ligne du tableau structuré est traitée.

La fonction renvoie : le numéro de la ligne concernée ou -1 en cas d’erreur.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_IndexLigne(TS As Range, Ligne As Long) As Long
'------------------------------------------------------------------------------------------------
' Contrôle la cohérence du numéro de la ligne passée en argument dans un tableau structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Ligne : le numéro de la ligne.
'         Si vide ou 0 alors traite la dernière ligne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : le numéro de la ligne dans le tableau ou -1 si erreur.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' S'il faut traiter la dernière Ligne:
If Ligne = 0 Then Ligne = TS.ListObject.ListRows.Count

' Contrôle la cohérence de la Ligne passée en argument:
If Ligne < 0 Or Ligne > TS.ListObject.ListRows.Count Then
TS_IndexLigne = -1
Else
TS_IndexLigne = Ligne
End If

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Or TS_IndexLigne = -1 Then
TS_IndexLigne = -1
TS_Err_Description = "La Ligne [" & Ligne & "] n'est pas inclue dans le tableau."
End If
Err.Clear

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

II-G - TS_ChangerLibellé

La fonction TS_ChangerLibellé affiche un libellé personnalisé à la place du nom d’une colonne d’un tableau structuré, sans modifier le nom de cette colonne qui restera celui exploité dans les traitements.

Cette notion est très utile, car elle permet :

- de conserver un nom court pour désigner la colonne qui sera utilisée dans les traitements et les formules tout en affichant un texte plus explicite pour les utilisateurs ;

- d’éviter les caractères spéciaux dans le nom des colonnes (voir la remarque ci-dessous) ;

- d’adapter le libellé affiché au souhait de l’utilisateur sans avoir à modifier le code déjà écrit ;

- de faciliter le portage d’une application dans une autre langue.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée ;

- Libellé : le libellé à afficher à la place du nom ou vide pour restaurer le nom d'origine.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour modifier l’affichage des colonnes « Nom », « Prénom » et « Note » du tableau structuré nommé « TS_Eleves », en forçant un retour à la ligne par vbCrLf :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_ChangerLibellé(Tableau, "Nom", "Nom de" & vbCrLf & "l'élève")
Call TS_ChangerLibellé(Tableau, "Prénom", "Prénom de" & vbCrLf & "l'élève")
Call TS_ChangerLibellé(Tableau, 0, "1ère" & vbCrLf & "Note")
End Sub
'------------------------------------------------------------------------------------------------

Pour simplifier vos traitements, nommez vos colonnes en évitant les caractères spéciaux « arobase, dièse (croisillons), tabulation, saut de ligne, virgule, point, crochets, apostrophe, , ... », qui nécessitent dans les formules l’usage de crochets supplémentaires ou d'être précédés d'une apostrophe (simple quote).

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ChangerLibellé(TS As Range, _
ByVal Colonne As Variant, _
Libellé As String) As Boolean
'------------------------------------------------------------------------------------------------
' Change l'affichage de l'en-tête dans un Tableau Structuré, mais pas son nom.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Libellé : le libellé à afficher à la place du nom du champ, ou vide pour le nom d'origine.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Affiche l'en-tête et change le libellé:
TS.ListObject.ShowHeaders = True
If Libellé <> "" Then
TS.ListObject.HeaderRowRange(Colonne).NumberFormat = "0;"""";"""";""" & Libellé & """"
Else
TS.ListObject.HeaderRowRange(Colonne).NumberFormat = "@"
End If
TS_ChangerLibellé = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ChangerLibellé", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ChangerLibellé"
End If

Err.Clear

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

II-H - TS_EffacerUneLigne

La fonction TS_EffacerUneLigne efface le contenu d’une ligne dans un tableau structuré, mais ne supprime pas la ligne.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Ligne : le numéro de la ligne concernée. Si ce nombre est zéro, alors la dernière ligne du tableau structuré est effacée.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour effacer la dernière ligne du tableau structuré nommé « TS_Eleves » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_EffacerUneLigne(TS:=Tableau, Ligne:=0)
End Sub
'------------------------------------------------------------------------------------------------

Ou :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Call TS_EffacerUneLigne(Range("TS_Eleves"), 0)
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_EffacerUneLigne(TS As Range, ByVal Ligne As Long) As Boolean
'------------------------------------------------------------------------------------------------
' Efface le contenu d'une ligne dans un Tableau Structuré, mais ne la supprime pas, même si elle est masquée.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Ligne : la position de la ligne à effacer dans le tableau.
'         Si 0 alors efface la dernière ligne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si l'effacement a été réalisé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Contrôle la cohérence de la ligne passée en argument:
Ligne = TS_IndexLigne(TS, Ligne)
If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Efface la ligne:
Select Case TS.ListObject.ListRows.Count
Case Is > 1
TS.ListObject.DataBodyRange.Rows(Ligne).Clear
Case 1
Dim i As Long
For i = 1 To TS.ListObject.ListColumns.Count
TS.ListObject.DataBodyRange(1, i).Clear
Next i
End Select
TS_EffacerUneLigne = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_EffacerUneLigne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_EffacerUneLigne"
End If

Err.Clear

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

II-I - TS_EffacerToutesLignes

La fonction TS_EffacerToutesLignes efface le contenu d’un tableau structuré, mais ne le supprime pas.

Son argument est :

- TS : la plage (de type Range) qui représente le tableau structuré.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour effacer le contenu du tableau structuré nommé « TS_Eleves » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_EffacerToutesLignes(Tableau)
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_EffacerToutesLignes(TS As Range) As Boolean
'------------------------------------------------------------------------------------------------
' Efface le contenu de toutes les lignes dans un Tableau Structuré, mais ne les supprime pas,
' même si elles sont masquées.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Efface toutes les lignes du tableau:
Select Case TS.ListObject.ListRows.Count
Case Is > 1
TS.ListObject.DataBodyRange.Clear
Case 1
Dim i As Long
For i = 1 To TS.ListObject.ListColumns.Count
TS.ListObject.DataBodyRange(1, i).Clear
Next i
End Select
TS_EffacerToutesLignes = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_EffacerToutesLignes", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_EffacerToutesLignes"
End If
Err.Clear

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

II-J - TS_AjouterUneLigne

La fonction TS_AjouterUneLigne ajoute une ligne dans un tableau structuré.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Ligne : (facultatif) la position où ajouter une ligne. Si ce nombre est zéro (valeur par défaut), alors une ligne est ajoutée à la suite du tableau structuré.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour ajouter une ligne en deuxième position puis à la fin du tableau structuré nommé « TS_Eleves » :

‘------------------------------------------------------------------------------------------------
Sub Exemple()
‘------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_AjouterUneLigne(TS:=Tableau, Ligne:=2)
Call TS_AjouterUneLigne(TS:=Tableau, Ligne:=0)
End Sub
‘------------------------------------------------------------------------------------------------

Remarque : avant d’ajouter une ligne au tableau, il convient de mémoriser les éventuels filtres existants et de les supprimer, puis de les restaurer à la fin du traitement. Nous verrons cela en détail dans un autre chapitre.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_AjouterUneLigne(TS As Range, Optional ByVal Ligne As Long = 0) As Boolean
'------------------------------------------------------------------------------------------------
' Ajoute une ligne dans un Tableau Structuré (même si elle est masquée).
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Ligne : la position où ajouter la ligne dans le tableau.
'         Si 0 alors ajoute la ligne à la suite du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une ligne a été ajoutée.
'------------------------------------------------------------------------------------------------
Dim MesFiltres As Variant
Dim Anc_ScreenUpdating As Boolean

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

' Si le tableau est vierge alors il faut l'initialiser:
If TS.ListObject.ListRows.Count = 0 Then
Set TS = TS.ListObject.ListRows.Add.Range
TS_AjouterUneLigne = True
Exit Function
End If

' Contrôle la cohérence de la ligne passée en argument:
If Ligne <> 0 Then
Ligne = TS_IndexLigne(TS, Ligne)
If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
End If

' Bloque la mise à jour de l'écran:
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' Mémorise les éventuels filtres et les retire:
Call TS_Filtres_Mémoriser(TS, MesFiltres)
Call TS_Filtres_Effacer(TS)

Select Case Ligne

Case 0 ' Ajoute une ligne en bas du tableau:
TS.ListObject.ListRows.Add AlwaysInsert:=False
TS_AjouterUneLigne = True

Case 1 To TS.ListObject.ListRows.Count ' Ajoute dans le tableau
TS.ListObject.ListRows.Add Position:=Ligne, AlwaysInsert:=False
TS_AjouterUneLigne = True

End Select

' Restaure les filtres et l'affichage:
Call TS_Filtres_Restaurer(TS, MesFiltres)
Application.ScreenUpdating = Anc_ScreenUpdating

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description

If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_AjouterUneLigne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_AjouterUneLigne"
End If

Err.Clear
End Function
‘------------------------------------------------------------------------------------------------

II-K - TS_SupprimerUneLigne

La fonction TS_SupprimerUneLigne supprime une ligne dans un tableau structuré.

Une fois toutes les lignes supprimées, il ne reste qu’une ligne vide sous l’en-tête. En VBA, le tableau sera initialisé lors de l’ajout d’une première ligne, voir la fonction TS_AjouterUneLigne.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Ligne : le numéro de la ligne à supprimer. Si ce nombre est zéro, alors la dernière ligne du tableau structuré est supprimée.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour supprimer la dernière ligne du tableau structuré nommé « TS_Eleves » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_SupprimerUneLigne(Tableau, 0)
End Sub
'------------------------------------------------------------------------------------------------

Remarque : avant de supprimer une ligne au tableau, il convient de mémoriser les éventuels filtres existants et de les supprimer, puis de les restaurer à la fin du traitement. Nous verrons cela en détail dans un autre chapitre.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_SupprimerUneLigne(TS As Range, ByVal Ligne As Long) As Boolean
'------------------------------------------------------------------------------------------------
' Supprime une ligne dans un Tableau Structuré, même si elle est masquée.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Ligne : la position de la ligne à supprimer dans le tableau.
'         Si 0 alors supprime la dernière ligne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une ligne a été supprimée.
'------------------------------------------------------------------------------------------------
Dim MesFiltres As Variant
Dim Anc_ScreenUpdating As Boolean

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

' Contrôle la cohérence de la ligne passée en argument:
Ligne = TS_IndexLigne(TS, Ligne)
If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Bloque la mise à jour de l'écran:
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' Mémorise les éventuels filtres et les retire:
Call TS_Filtres_Mémoriser(TS, MesFiltres)
Call TS_Filtres_Effacer(TS)

' Supprime la ligne:
TS.ListObject.ListRows(Ligne).Delete
TS_SupprimerUneLigne = True

' Restaure les filtres et l'affichage:
Call TS_Filtres_Restaurer(TS, MesFiltres)
Application.ScreenUpdating = Anc_ScreenUpdating

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_SupprimerUneLigne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_SupprimerUneLigne"
End If
Err.Clear

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

II-L - TS_SupprimerPlusieursLignes

La fonction TS_SupprimerPlusieursLignes supprime plusieurs lignes consécutives dans un tableau structuré.

Une fois toutes les lignes supprimées il ne reste qu’une ligne vide sous l’en-tête. En VBA, le tableau sera initialisé lors de l’ajout d’une première ligne, voir la fonction TS_AjouterUneLigne.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- LigneDébut : le numéro de la première ligne à supprimer ;

- LigneFin : le numéro de la dernière ligne à supprimer (si ce nombre est zéro alors la dernière ligne du tableau structuré est supprimée).

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour supprimer de la huitième ligne jusqu'à la dernière ligne du tableau structuré nommé « TS_Eleves » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_SupprimerPlusieursLignes(Tableau, 8, 0)
End Sub
'------------------------------------------------------------------------------------------------

Remarque : avant de supprimer les lignes au tableau, il convient de mémoriser les éventuels filtres existants et de les supprimer, puis de les restaurer à la fin du traitement. Nous verrons cela en détail dans un autre chapitre.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_SupprimerPlusieursLignes(TS As Range, ByVal LigneDébut As Long, ByVal LigneFin As Long) As Boolean
'------------------------------------------------------------------------------------------------
' Supprime plusieurs lignes dans un Tableau Structuré, même si elles sont masquées.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' LigneDébut : La position de la première ligne à supprimer dans le tableau.
' LigneFin   : La position de la dernière ligne à supprimer dans le tableau
'              Si 0 alors supprime la dernière ligne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si une ligne a été supprimée.
'------------------------------------------------------------------------------------------------
' Remarque : Une fois toutes les lignes supprimées, il ne reste qu'une ligne vide sous l'en-tête.
'------------------------------------------------------------------------------------------------
Dim MesFiltres As Variant
Dim Anc_ScreenUpdating As Boolean
Dim Ligne As Long

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

' Si la ligne de début est hors du tableau alors ne rien faire:
If LigneDébut > TS.ListObject.ListRows.Count Then
TS_SupprimerPlusieursLignes = True
GoTo Gest_Err
End If

' Contrôle la cohérence des lignes passées en argument:
LigneDébut = TS_IndexLigne(TS, LigneDébut)
If LigneDébut = -1 Then Err.Raise vbObjectError, , TS_Err_Description
LigneFin = TS_IndexLigne(TS, LigneFin)
If LigneFin = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' S'il faut inverser le début et la fin:
If LigneFin < LigneDébut Then
Ligne = LigneDébut
LigneDébut = LigneFin
LigneFin = Ligne
End If

' Bloque la mise à jour de l'écran:
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' Mémorise les éventuels filtres et les retire:
Call TS_Filtres_Mémoriser(TS, MesFiltres)
Call TS_Filtres_Effacer(TS)

' Supprime les lignes:
TS.ListObject.DataBodyRange.Rows(LigneDébut & ":" & LigneFin).Delete
TS_SupprimerPlusieursLignes = True

' Restaure les filtres et l'affichage:
Call TS_Filtres_Restaurer(TS, MesFiltres)
Application.ScreenUpdating = Anc_ScreenUpdating

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_SupprimerPlusieursLignes", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_SupprimerPlusieursLignes"
End If
Err.Clear

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

II-M - TS_SupprimerToutesLignes

La fonction TS_SupprimerToutesLignes supprime toutes les lignes dans un tableau structuré, mais ne le supprime pas (pour cela utilisez la fonction TS_SupprimerLeTableau), il ne reste qu'une ligne vide sous l'en-tête. En VBA, le tableau sera initialisé lors de l’ajout d’une première ligne, voir la fonction TS_AjouterUneLigne.

Son argument est :

- TS : la plage (de type Range) qui représente le tableau structuré.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour supprimer toutes les lignes du tableau structuré nommé « TS_Eleves » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_SupprimerToutesLignes(Tableau)
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_SupprimerToutesLignes(TS As Range) As Boolean
'------------------------------------------------------------------------------------------------
' Supprime toutes les lignes d'un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Efface les éventuels filtres:
Call TS_Filtres_Effacer(TS)

' Supprime toutes les lignes:
If Not TS.ListObject.DataBodyRange Is Nothing Then TS.ListObject.DataBodyRange.Delete
TS_SupprimerToutesLignes = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_SupprimerToutesLignes", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_SupprimerToutesLignes"
End If
Err.Clear

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

II-N - TS_SupprimerLignesVisibles

La fonction TS_SupprimerLignesVisibles supprime les lignes visibles dans un tableau structuré, lignes préalablement sélectionnées par un filtre.

Si toutes les lignes sont supprimées il ne reste qu’une ligne vide sous l’en-tête. En VBA, le tableau sera initialisé lors de l’ajout d’une première ligne, voir la fonction TS_AjouterUneLigne.

Son argument est :

- TS : la plage (de type Range) qui représente le tableau structuré.

La fonction renvoie : le nombre de lignes supprimées ou -1 en car d'erreur.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Function TS_SupprimerLignesVisibles(TS As Range) As Long
'------------------------------------------------------------------------------------------------
' Supprime les lignes visibles dans un tableau structuré, lignes normalement préalablement
' sélectionnées avec les filtres (si tout est affiché alors le tableau est vidé).
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : Le nombre de lignes supprimées ou -1 en cas d'erreur.
'------------------------------------------------------------------------------------------------
Dim NbAvant As Long, AncDisplayAlerts As Boolean

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

' Compte le nombre de ligne avant le traitement:
NbAvant = TS_Nombre_Lignes(TS)

' Suppression des lignes visibles:
AncDisplayAlerts = Application.DisplayAlerts
Application.DisplayAlerts = False
TS.ListObject.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = AncDisplayAlerts

' Renvoie le nombre de lignes supprimées:
TS_SupprimerLignesVisibles = NbAvant - TS_Nombre_Lignes(TS)

' Fin du traitement, renvoie -1 en cas d'erreur:
Gest_Err:
If Err.Number = 1004 Then Err.Clear ' Pas de donnée.
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then TS_SupprimerLignesVisibles = -1
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_SupprimerLignesVisibles", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_SupprimerLignesVisibles"
End If
Err.Clear

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

II-O - TS_SupprimerLignesMasquées

La fonction TS_SupprimerLignesMasquées supprime les lignes masquées dans un tableau structuré suite à l'utilisation d'un filtre.

Son argument est :

- TS : la plage (de type Range) qui représente le tableau structuré.

La fonction renvoie : le nombre de lignes supprimées ou -1 en car d'erreur.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Function TS_SupprimerLignesMasquées(TS As Range) As Long
'------------------------------------------------------------------------------------------------
' Supprime les lignes masquées dans un tableau structuré, lignes normalement préalablement
' masquées avec les filtres (une ligne filtrée ne peut pas être supprimée c'est pourquoi il faut
' ôter les filtres pour supprimer les lignes concernées puis restaurer les filtres).
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : Le nombre de lignes supprimées ou -1 en cas d'erreur.
'------------------------------------------------------------------------------------------------
Dim NbAvant As Long, y As Long
Dim MesFiltres As Variant
Dim Anc_ScreenUpdating As Boolean
Dim Lignes() As Long

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

' Compte le nombre de ligne avant le traitement:
NbAvant = TS_Nombre_Lignes(TS)
ReDim Lignes(0 To NbAvant)

' Mémorise les lignes masquées (càd hauteur = 0):
For y = 1 To TS_Nombre_Lignes(TS)
Lignes(y) = TS.ListObject.DataBodyRange(y, 1).Height
Next y

' Bloque la mise à jour de l'écran:
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' Mémorise les éventuels filtres et les retire:
Call TS_Filtres_Mémoriser(TS, MesFiltres)
Call TS_Filtres_Effacer(TS)

' Supprime les lignes qui étaient masquées:
For y = TS_Nombre_Lignes(TS) To 1 Step -1
If Lignes(y) = 0 Then TS.ListObject.ListRows(y).Delete
Next y

' Restaure les filtres et l'affichage:
Call TS_Filtres_Restaurer(TS, MesFiltres)
Application.ScreenUpdating = Anc_ScreenUpdating

' Renvoie le nombre de lignes supprimées:
TS_SupprimerLignesMasquées = NbAvant - TS_Nombre_Lignes(TS)

' Fin du traitement, renvoie -1 en cas d'erreur:
Gest_Err:
If Err.Number = 1004 Then Err.Clear ' Pas de donnée.
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then TS_SupprimerLignesMasquées = -1
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_SupprimerLignesMasquées", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_SupprimerLignesMasquées"
End If
Err.Clear

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

II-P - TS_SupprimerDoublons

La fonction TS_SupprimerDoublons supprime les doublons dans un tableau structuré. Les lignes masquées par un filtre sont quand même prises en compte

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- ListeColonnes : la ou les colonnes concernées (dans ce cas passez un Array).

La fonction renvoie : le nombre de lignes supprimées ou -1 en car d'erreur.

Exemples d'appels sur le tableau « TS_Eleves » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim TS As Range
Set TS = Range("TS_Eleves")
Call TS_SupprimerDoublons(TS, "Nom") ' Supprime les doublons de la colonne nommée "Nom"
Call TS_SupprimerDoublons(TS, Array("Nom", "Prénom")) ' idem mais si doublons en colonnes "Nom" et "Prénom".
Call TS_SupprimerDoublons(TS, 0) ' Supprime les doublons de la dernière colonne.
Call TS_SupprimerDoublons(TS, Array("Nom", 0)) ' idem mais si doublons en colonnes "Nom" et dernière colonne.
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Function TS_SupprimerDoublons(TS As Range, ListeColonnes As Variant) As Long
'------------------------------------------------------------------------------------------------
' Supprime les doublons dans un tableau structuré sur une ou plusieurs colonnes de critères,
' les lignes filtrées masquées sont quand même prises en compte.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' ListeColonnes : La ou les colonnes concernées (dans ce cas passez un Array).
'------------------------------------------------------------------------------------------------
' Renvoie : Le nombre de lignes supprimées ou -1 en cas d'erreur.
'------------------------------------------------------------------------------------------------
Dim NbAvant As Long
Dim Colonnes As String, i As Integer

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

' Compte le nombre de ligne avant le traitement:
NbAvant = TS_Nombre_Lignes(TS)

' Récupère le numéro des colonnes:
If IsArray(ListeColonnes) = True Then
Colonnes = TS_IndexColonne(TS, ListeColonnes(0))
For i = 1 To UBound(ListeColonnes)
Colonnes = Colonnes & "," & TS_IndexColonne(TS, ListeColonnes(i))
Next i
Else
Colonnes = TS_IndexColonne(TS, ListeColonnes)
End If

' Suppression des doublons:
TS.ListObject.Range.RemoveDuplicates Columns:=Array(Colonnes), Header:=xlYes

' Renvoie le nombre de lignes supprimées:
TS_SupprimerDoublons = NbAvant - TS_Nombre_Lignes(TS)

' Fin du traitement, renvoie -1 en cas d'erreur:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then TS_SupprimerDoublons = -1
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_SupprimerDoublons", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_SupprimerDoublons"
End If
Err.Clear

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

II-Q - TS_AjouterUneColonne

La fonction TS_AjouterUneColonne ajoute une colonne dans un tableau structuré.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le numéro de la colonne ou le nom de la colonne après lequel insérer une nouvelle colonne. Si vide ou 0, alors ajoute une colonne à la fin du tableau structuré ;

- Nom : le nom de la nouvelle colonne. Si vide, alors Excel attribuera un nom d'office et « Nom » sera renseigné.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour ajouter une colonne nommée « Note2 » à la fin du tableau structuré nommé « TS_Eleves », puis lui changer son libellé en « 2e Note » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_AjouterUneColonne(TS:=Tableau, Colonne:=0, Nom:="Note2")
Call TS_ChangerLibellé(TS:=Tableau, Colonne:=0, Libellé:="2ème" & vbCrLf & "Note")
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_AjouterUneColonne(TS As Range, _
ByVal Colonne As Variant, _
Nom As String) As Boolean
'------------------------------------------------------------------------------------------------
' Ajoute une colonne dans un tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne où insérer une nouvelle colonne.
'           Si vide ou 0 alors ajoute une colonne à la fin du tableau.
' Nom = Le nom de la nouvelle colonne.
'       Si vide alors Excel attribuera un nom d'office et Nom sera alimenté.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une colonne a été ajoutée.
'------------------------------------------------------------------------------------------------
Dim i As Integer

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
TS.ListObject.ShowHeaders = True

' Si le nom existe déjà alors il n'est pas possible de créer la nouvelle colonne:
For i = 1 To TS.ListObject.ListColumns.Count
If TS.ListObject.ListColumns(i).Name = Nom Then _
Err.Raise vbObjectError, , "La colonne [" & Nom & "] existe déjà dans le tableau."
Next i

' S'il faut traiter la dernière colonne:
If Colonne = "" Then Colonne = 0

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
If Colonne <> 0 Then
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
End If

Select Case Colonne

Case 0 ' Ajoute une colonne à la suite du tableau:
TS.ListObject.ListColumns.Add.Name = Nom
Nom = TS.ListObject.ListColumns(TS.ListObject.ListColumns.Count).Name
TS.ListObject.HeaderRowRange(TS.ListObject.ListColumns.Count).NumberFormat = "@"
TS_AjouterUneColonne = True

Case Else ' Ajoute une colonne dans le tableau:
TS.ListObject.ListColumns.Add(Colonne).Name = Nom
Nom = TS.ListObject.ListColumns(Colonne).Name
TS.ListObject.HeaderRowRange(Colonne).NumberFormat = "@"
TS_AjouterUneColonne = True

End Select

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_AjouterUneColonne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_AjouterUneColonne"
End If
Err.Clear

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

II-R - TS_SupprimerUneColonne

La fonction TS_SupprimerUneColonne supprime une colonne dans un tableau structuré.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le numéro de la colonne ou le nom de la colonne à supprimer. Si vide ou 0, alors supprime la dernière colonne du tableau structuré.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Remarque : supprimer toutes les colonnes d’un tableau structuré équivaut à le supprimer, voir la fonction TS_SupprimerLeTableau.

Exemple pour supprimer la colonne « Note2 » du tableau structuré nommé « TS_Eleves » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_SupprimerUneColonne(TS:=Tableau, Colonne:="Note2")
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_SupprimerUneColonne(TS As Range, ByVal Colonne As Variant) As Boolean
'------------------------------------------------------------------------------------------------
' Supprime une colonne dans un tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne à supprimer.
'           Si vide ou 0 alors supprime la dernière colonne du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une colonne a été supprimée.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Supprime une colonne dans le tableau:
TS.ListObject.ListColumns(Colonne).Delete
TS_SupprimerUneColonne = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise Err.Number, "TS_SupprimerUneColonne", Err.Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox Err.Number & " : " & Err.Description, vbInformation, "TS_SupprimerUneColonne"
End If
Err.Clear

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

II-S - TS_DéplacerUneColonne

La fonction TS_DéplacerUneColonne déplace une colonne dans un tableau structuré.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne_Source : le numéro de la colonne ou le nom de la colonne à déplacer. Si vide ou 0, alors déplace la dernière colonne ;

- Colonne_Dest : le numéro de la colonne destination où déplacer les données. Si vide ou 0, alors déplace les données la dernière colonne.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour s'assurer que les colonnes du tableau structuré « TS_Eleves » sont bien dans l'ordre désiré. Les colonnes sont déplacées en cas de besoin :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim i As Integer
Dim Ordre As Variant

' Définition des colonnes que l'on souhaite déplacer
Ordre = Array("Nom", "Prénom", "Note", "Date", "Prochain")

' Boucle sur les colonnes pour les déplacer dans cet ordre.
' Attention le tableau est en base 0 (de 0 à n-1) alors que les colonnes
' d'un tableau structuré vont de 1 à n et pas de 0 à n-1:
For i = LBound(Ordre) To UBound(Ordre)
Call TS_DéplacerUneColonne(TS:=Range("TS_Eleves"), Colonne_Source:=Ordre(i), Colonne_Dest:=i + 1)
Next i

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

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_DéplacerUneColonne(TS As Range, _
ByVal Colonne_Source As Variant, _
ByVal Colonne_Dest As Variant) As Boolean
'------------------------------------------------------------------------------------------------
' Déplace une colonne dans un tableau structuré.
'------------------------------------------------------------------------------------------------------
' TS : le tableau structuré.
' Colonne_Source : la colonne à déplacer (son nom ou son numéro).
'                  Si 0 alors déplace la dernière colonne.
' Colonne_Dest : la colonne destination où déplacer les données (son nom ou son numéro).
'                Si 0 alors déplace les données à la dernière colonne.
'------------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim Nom As String, NomCréé As String
Dim MesFiltres As Variant
Dim Anc_ScreenUpdating As Boolean
Dim Anc_Cursor As Long
Dim Titres() As Variant
Dim i As Integer, id As Integer, y As Long
Dim Copie As Variant

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

' Bloque les mises à jour de l'écran:
Anc_Cursor = Application.Cursor
Application.Cursor = xlWait
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' Mémorise les titres (libellé et largeur):
ReDim Titre(1 To TS.ListObject.ListColumns.Count, 1 To 3)
For i = 1 To TS.ListObject.ListColumns.Count
Titre(i, 1) = TS.ListObject.HeaderRowRange(i).Formula
Titre(i, 2) = TS.ListObject.ListColumns(i).Range.ColumnWidth
Titre(i, 3) = TS.ListObject.HeaderRowRange(i).NumberFormat
Next i

' Retrouve le numéro de la colonne source et vérifie sa cohérence (ou -1 si erreur):
Colonne_Source = TS_IndexColonne(TS, Colonne_Source)
If Colonne_Source = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Retrouve le numéro de la colonne destination et vérifie sa cohérence (ou -1 si erreur):
Colonne_Dest = TS_IndexColonne(TS, Colonne_Dest)
If Colonne_Dest = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' S'il faut déplacer la colonne:
If Colonne_Source <> Colonne_Dest Then

' Mémorise les éventuels filtres et les retire:
Call TS_Filtres_Mémoriser(TS, MesFiltres)
Call TS_Filtres_Effacer(TS)

' Mémorise le nom de la colonne source:
Nom = TS.ListObject.ListColumns(Colonne_Source).Name
' Mémorise toutes les formules:
Copie = TS.ListObject.DataBodyRange.Formula
' Corrige le numéro de la colonne destination si ajout:
If Colonne_Source < Colonne_Dest Then Colonne_Dest = Colonne_Dest + 1
' Ajoute une colonne et mémorise le nom attribué par Excel:
TS.ListObject.ListColumns.Add Position:=Colonne_Dest
NomCréé = TS.ListObject.ListColumns(Colonne_Dest).Name
' Retrouve la position de la colonne source:
Colonne_Source = TS.ListObject.ListColumns(Nom).Index
' Copie la source dans la destination puis supprime la source:
TS.ListObject.ListColumns(Colonne_Source).DataBodyRange.Cut TS.ListObject.ListColumns(Colonne_Dest).DataBodyRange
TS.ListObject.ListColumns(Colonne_Source).Delete
' Retrouve la position de la colonne destination pour lui affecté le nom d'origine:
Colonne_Dest = TS.ListObject.ListColumns(NomCréé).Index
TS.ListObject.ListColumns(Colonne_Dest).Name = Nom
' Ainsi que ses formules:
TS.ListObject.ListColumns(Colonne_Dest).DataBodyRange.Formula = Copie

' Restaure les filtres et l'affichage:
Call TS_Filtres_Restaurer(TS, MesFiltres)

' Restaure les titres:
For i = 1 To TS.ListObject.ListColumns.Count
id = TS.ListObject.ListColumns(Titre(i, 1)).Index
TS.ListObject.ListColumns(id).Range.ColumnWidth = Titre(i, 2)
TS.ListObject.HeaderRowRange(id).NumberFormat = Titre(i, 3)
' Restaure les formules:
For y = 1 To TS.ListObject.ListRows.Count
TS.ListObject.Range(y + 1, id) = Copie(y, i)
Next y
Next i

End If

' Fin du traitement:
Gest_Err:
Application.Cursor = Anc_Cursor
Application.ScreenUpdating = Anc_ScreenUpdating

TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_DéplacerUneColonne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_DéplacerUneColonne"
End If
Err.Clear

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

II-T - TS_AfficherOuMasquerColonne

La fonction TS_AfficherOuMasquerColonne permet d'afficher ou de masquer une colonne dans un tableau structuré.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le numéro ou le nom de la colonne concernée. Si vide ou 0, alors prend la dernière colonne du tableau structuré ;

- EstVisible : Si True alors la colonne est visible, si False alors elle est masquée.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_AfficherOuMasquerColonne(TS As Range, _
ByVal Colonne As Variant, _
EstVisible As Boolean) As Boolean
'------------------------------------------------------------------------------------------------
' Affiche ou masque une colonne d'un tableau structuré situé dans ce classeur.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' EstVisible : Si VRAI alors la colonne est visible, si FAUX alors elle est masquée.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Retrouve la colonne sur la feuille:
Colonne = Colonne + TS.Column - 1

' Affiche ou Masque:
Sheets(TS.Parent.Name).Columns(Colonne).EntireColumn.Hidden = Not EstVisible

' Renvoie VRAI:
TS_AfficherOuMasquerColonne = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_AfficherOuMasquerColonne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_AfficherOuMasquerColonne"
End If
Err.Clear

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

II-U - TS_LargeurColonne

La fonction TS_LargeurColonne définit la largeur (en points) d'une colonne d'un tableau structuré situé dans le classeur.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le numéro ou le nom de la colonne concernée. Si vide ou 0, alors prend la dernière colonne du tableau structuré ;

- Largeur : la largeur de la colonne ou 0 pour un ajustement automatique.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_LargeurColonne(TS As Range, _
ByVal Colonne As Variant, _
ByVal Largeur As Double) As Boolean
'------------------------------------------------------------------------------------------------
' Définit la largeur (en points) d'une colonne d'un tableau structuré situé dans ce classeur.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Largeur : La largeur de la colonne ou 0 pour un ajustement automatique.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Retrouve la colonne sur la feuille:
Colonne = Colonne + TS.Column - 1

' Définit la largeur:
Select Case Largeur
Case 0: Sheets(TS.Parent.Name).Columns(Colonne).EntireColumn.AutoFit
Case Else: Sheets(TS.Parent.Name).Columns(Colonne).ColumnWidth = Largeur
End Select

' Renvoie VRAI:
TS_LargeurColonne = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_LargeurColonne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_LargeurColonne"
End If
Err.Clear

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

II-V - TS_EffacerUneColonne

La fonction TS_EffacerUneColonne efface toutes les cellules d'une colonne d'un tableau structuré situé dans le classeur.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le numéro ou le nom de la colonne concernée. Si vide ou 0, alors prend la dernière colonne du tableau structuré.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_EffacerUneColonne(TS As Range, ByVal Colonne As Variant) As Boolean
'------------------------------------------------------------------------------------------------
' Efface toutes les cellules (visibles ou non) d'une colonne dans un Tableau Structuré.
' ListColumns réagit différemment sur les cellules visibles ou non suivant que la feuille
' est active ou non, c'est pourquoi la colonne est masquée pour effacer toutes les cellules.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : La position de la colonne à effacer dans le tableau.
'           Si 0 alors efface la dernière colonne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si l'effacement a été réalisé.
'------------------------------------------------------------------------------------------------
Dim AncVisible As Boolean

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

' S'il y a au moins une ligne:
If TS.ListObject.ListRows.Count > 0 Then

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Mémorise l'état visibile ou non de la colonne puis la masque:
AncVisible = Sheets(TS.Parent.Name).Columns(Colonne + TS.Column - 1).EntireColumn.Hidden
Sheets(TS.Parent.Name).Columns(Colonne + TS.Column - 1).EntireColumn.Hidden = True

' Efface une colonne dans le tableau:
TS.ListObject.ListColumns(Colonne).DataBodyRange.Clear

' Puis restaure l'ancien état visible ou non de la colonne:
Sheets(TS.Parent.Name).Columns(Colonne + TS.Column - 1).EntireColumn.Hidden = AncVisible

End If

' Renvoie Vrai:
TS_EffacerUneColonne = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_EffacerUneColonne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_EffacerUneColonne"
End If

Err.Clear
End Function
'------------------------------------------------------------------------------------------------

II-W - TS_OptionsStyle

La fonction TS_OptionsStyle définit les options de style du tableau structuré à afficher ou masquer.
Soit l’équivalant de l’onglet « Création » du ruban lorsque le tableau est sélectionné :

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Bouton_Filtre : (facultatif) True pour activer l’option, False pour désactiver l’option ;

- Ligne_Entête : (facultatif) True pour activer l’option, False pour désactiver l’option ;

- Ligne_Totaux : (facultatif) True pour activer l’option, False pour désactiver l’option ;

- Ligne_Bandes : (facultatif) True pour activer l’option, False pour désactiver l’option ;

- Colonne_Bandes : (facultatif) True pour activer l’option, False pour désactiver l’option ;

- Première_Colonne : (facultatif) True pour activer l’option, False pour désactiver l’option ;

- Dernière_Colonne : (facultatif) True pour activer l’option, False pour désactiver l’option ;

- StyleTableau : (facultatif) le nom du style du tableau structuré. Si l’argument est vide, alors le tableau sera sans style, s’il n’est pas renseigné le style ne sera pas modifié.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour masquer le bouton de filtre du tableau structuré nommé « TS_Eleves », afficher la ligne des totaux et le passer en style « moyen 6 » sans modifier les autres options :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_OptionsStyle(TS:=Tableau, Bouton_Filtre:=False, Ligne_Totaux:=True, StyleTableau:="TableStyleMedium6")
End Sub
'------------------------------------------------------------------------------------------------

Ou sans nommer les arguments (instruction plus courte, mais moins intuitive à relire) :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_OptionsStyle(Tableau, False, , True, , , , , "TableStyleMedium6")
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_OptionsStyle(TS As Range, _
Optional Bouton_Filtre As Integer = 1, _
Optional Ligne_Entête As Integer = 1, _
Optional Ligne_Totaux As Integer = 1, _
Optional Ligne_Bandes As Integer = 1, _
Optional Colonne_Bandes As Integer = 1, _
Optional Première_Colonne As Integer = 1, _
Optional Dernière_Colonne As Integer = 1, _
Optional StyleTableau As String = "/") As Boolean
'------------------------------------------------------------------------------------------------
' Paramétrage des options de style du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : Le Tableau Structuré.
' Options : Si ignorée = l'option est laissée dans son état.
'           Si True = l'option est passée à True.
'           Si False = l'option est passée à False.
' StyleTableau : "" pour effacer ou le nom existant.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

Select Case Ligne_Entête
Case True: TS.ListObject.ShowHeaders = True
Case False: TS.ListObject.ShowHeaders = False
TS.ListObject.ShowAutoFilterDropDown = False
End Select

Select Case Ligne_Totaux
Case True: TS.ListObject.ShowTotals = True
Case False: TS.ListObject.ShowTotals = False
End Select

Select Case Ligne_Bandes
Case True: TS.ListObject.ShowTableStyleRowStripes = True
Case False: TS.ListObject.ShowTableStyleRowStripes = False
End Select

Select Case Première_Colonne
Case True: TS.ListObject.ShowTableStyleFirstColumn = True
Case False: TS.ListObject.ShowTableStyleFirstColumn = False
End Select

Select Case Dernière_Colonne
Case True: TS.ListObject.ShowTableStyleLastColumn = True
Case False: TS.ListObject.ShowTableStyleLastColumn = False
End Select

Select Case Colonne_Bandes
Case True: TS.ListObject.ShowTableStyleColumnStripes = True
Case False: TS.ListObject.ShowTableStyleColumnStripes = False
End Select

On Error GoTo Poser_Filtre
Select Case Bouton_Filtre
Case True: TS.ListObject.ShowHeaders = True
TS.ListObject.ShowAutoFilterDropDown = True
Case False: TS.ListObject.ShowAutoFilterDropDown = False
End Select
On Error GoTo 0

If StyleTableau <> "/" Then
Sheets(TS.Parent.Name).ListObjects(TS.ListObject.DisplayName).TableStyle = StyleTableau
End If

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number = 0 Then TS_OptionsStyle = True
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_OptionsStyle", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_OptionsStyle"
End If
Err.Clear

Exit Function

Poser_Filtre:
TS.ListObject.Range.AutoFilter
Resume Next

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

II-X - TS_DéfinirTotaux

La fonction TS_DéfinirTotaux définit le calcul pour la ligne des totaux d'une colonne d’un tableau structuré.
Si l’option d’affichage de la ligne des totaux n’était pas active, elle l’est automatiquement par l’appel à cette fonction.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée ;

- TypeCalcul : une valeur de l’énumération XlTotalsCalculation
- xlTotalsCalculationAverage : moyenne,
- xlTotalsCalculationCount : décompte des cellules non vides,
- xlTotalsCalculationCountNums : décompte des cellules contenant des valeurs numériques,
- xlTotalsCalculationMax : valeur maximale dans la liste,
- xlTotalsCalculationMin : valeur minimale dans la liste,
- xlTotalsCalculationNone : aucun calcul,
- xlTotalsCalculationStdDev : valeur écart-type,
- xlTotalsCalculationSum : somme de toutes les valeurs de la colonne de liste.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour compter le nombre d’élèves et la note moyenne :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_DéfinirTotaux(Tableau, "Nom", xlTotalsCalculationCount)
Call TS_DéfinirTotaux(Tableau, "Note", xlTotalsCalculationAverage)
End Sub
'------------------------------------------------------------------------------------------------

Remarque : nous étudierons dans un autre chapitre la mise en forme des cellules.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_DéfinirTotaux(TS As Range, _
ByVal Colonne As Variant, _
TypeCalcul As XlTotalsCalculation) As Boolean
'------------------------------------------------------------------------------------------------
' Définit le type de calcul pour la ligne des totaux d'une colonne.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' TypeCalcul : Type de calcul à appliquer suivant l'énumération.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Affiche les totaux et pose le calcul:
TS.ListObject.ShowTotals = True
TS.ListObject.ListColumns(Colonne).TotalsCalculation = TypeCalcul
TS_DéfinirTotaux = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_DéfinirTotaux", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_DéfinirTotaux"
End If
Err.Clear

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

II-Y - TS_FormatColonne

La fonction TS_FormatColonne définit le format numérique des cellules d'une colonne dans un tableau structuré. Les cellules masquées sont également affectées.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le numéro de la colonne ou le nom de la colonne concernée, ou 0 pour traiter la dernière colonne ;

- FormatColonne : le format numérique à appliquer ;

- ForcerNumérique : (facultatif) si True alors remplace la virgule "," par un point "." pour qu'Excel reconnaisse les nombres comme des numériques et puisse les traiter correctement.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour mettre la dernière colonne en format date (jour/mois/année) du tableau structuré nommé « TS_Eleves » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Call TS_FormatColonne(Range("TS_Eleves"), 0, "dd/mm/yyyy")
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_FormatColonne(TS As Range, _
ByVal Colonne As Variant, _
FormatColonne As String, _
Optional ForcerNumérique As Boolean = False) As Boolean
'------------------------------------------------------------------------------------------------
' Définit le format d'une colonne (valable aussi sur les lignes masquées).
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' FormatColonne : Le format à appliquer à la colonne.
' ForcerNumérique : Si VRAI alors remplace la virgule "," par un point "." pour qu'Excel reconnaisse
'                   le nombre comme des numériques et puisse les traiter correctement.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Exemples avec un tableau structuré nommé "Tableau1":
' Pour mettre la dernière colonne en date : Call TS_FormatColonne(Range("Tableau1"), 0, "dd/mm/yyyy")
' Et pour la mettre en numérique sans virgule : Call TS_FormatColonne(Range("Tableau1"), 0, "0.0", True)
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' S'il faut remplacer la virgule par un point pour forcer le mode numérique d'Excel:
If ForcerNumérique = True Then Call TS_Remplacer(TS, Colonne, ",", ".", False, xlPart)

' Pose le format:
TS.ListObject.ListColumns(Colonne).DataBodyRange.NumberFormat = FormatColonne

' Renvoie VRAI:
TS_FormatColonne = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_FormatColonne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_FormatColonne"
End If
Err.Clear

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

II-Z - TS_Aligner

La fonction TS_Aligner définit l'alignement vertical et/ou horizontal des données et/ou de l'en-tête et/ou du total d'une colonne dans un tableau structuré.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le numéro de la colonne ou le nom de la colonne concernée, ou 0 pour traiter la dernière colonne ;

- AlignementHorizontal : (facultatif) définit l'alignement horizontal suivant l’énumération XlHAlign
- -1 : (par défaut) ne modifie pas l'alignement,
- xlHAlignCenter = Centrer,
- xlHAlignCenterAcrossSelection = Centrer dans la sélection,
- xlHAlignDistributed = Distribuer,
- xlHAlignFill = Remplir,
- xlHAlignGeneral = Aligner en fonction du type de données,
- xlHAlignJustify = Justifier,
- xlHAlignLeft = Gauche,
- xlHAlignRight = Droite ;

- AlignementVertical : (facultatif) définit l'alignement vertical suivant l’énumération XlVAlign
- -1 : (par défaut) ne modifie pas l'alignement,
- xlVAlignBottom = Inférieure,
- xlVAlignCenter = Centre,
- xlVAlignDistributed = Distribué,
- xlVAlignJustify = Justifier,
- xlVAlignTop = Haut ;

- Aligner : (facultatif) définit quelles sont les cellules qui doivent être alignées suivant l’énumération personnelle Enum_TS_Aligner
- TS_Aligner_Données  = (par défaut) les données,
- TS_Aligner_Entete = l'en-tête,
- TS_Aligner_Total = la ligne du total.
Vous pouvez cumuler ces valeurs : TS_Aligner_Données + TS_Aligner_Entete + TS_Aligner_Total.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour centrer l'en-tête et le total et aligner à gauche les données de la dernière colonne :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Call TS_Aligner(Range("TS_Liste_Noms"),0,xlHAlignCenter, ,TS_Aligner_Total+TS_Aligner_Entete)
Call TS_Aligner(range("TS_Liste_Noms"),0,xlHAlignLeft)
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_Aligner(TS As Range, ByVal Colonne As Variant, _
Optional AlignementHorizontal As XlHAlign = -1, _
Optional AlignementVertical As XlVAlign = -1, _
Optional Aligner As Enum_TS_Aligner = TS_Aligner_Données) As Boolean
'------------------------------------------------------------------------------------------------
' Définit l'alignement vertical et/ou horizontal des données et/ou de l'en-tête et/ou du total
' d'une colonne dans un tableau structuré.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' AlignementHorizontal : (facultatif) Définit l'alignement horizontal suivant l'énumération XlHAlign:
'           -1                             = Ne modifie pas l'alignement (valeur par défaut).
'           xlHAlignCenter                 = Centrer.
'           xlHAlignCenterAcrossSelection  = Centrer dans la sélection.
'           xlHAlignDistributed            = Distribuer.
'           xlHAlignFill                   = Remplir.
'           xlHAlignGeneral                = Aligner en fonction du type de données.
'           xlHAlignJustify                = Justifier.
'           xlHAlignLeft                   = Gauche.
'           xlHAlignRight                  = Droite.
' AlignementVertical : (facultatif) Définit l'alignement vertical suivant l'énumération XlVAlign:
'           -1                             = Ne modifie pas l'alignement (valeur par défaut).
'           xlVAlignBottom                 = Inférieure
'           xlVAlignCenter                 = Centre
'           xlVAlignDistributed            = Distribué
'           xlVAlignJustify                = Justifier
'           xlVAlignTop                    = Haut
' Aligner : (facultatif) Définit quelles sont les cellules qui doivent être alignées.
'           TS_Aligner_Données = Les données uniquement (valeur par défaut).
'           TS_Aligner_Entete  = L'en-tête uniquement.
'           TS_Aligner_Total   = La ligne du total.
'           Vous pouvez cumuler ces valeurs : TS_Aligner_Données + TS_Aligner_Entete + TS_Aligner_Total
'------------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Remarque : Si l'en-tête et/ou le total doivent être alignés alors ils sont automatiquement affichés.
'------------------------------------------------------------------------------------------------------
' Exemple pour centrer l'en-tête et le total et aligner à gauche les données de la dernière colonne:
' Call TS_Aligner(Range("TS_Liste_Noms"),0,xlHAlignCenter, ,TS_Aligner_Total+TS_Aligner_Entete)
' Call TS_Aligner(range("TS_Liste_Noms"),0,xlHAlignLeft)
'------------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Alignement horizontal de la colonne:
If AlignementHorizontal <> -1 Then

' Les données:
If (Aligner And TS_Aligner_Données) > 0 Then _
TS.ListObject.ListColumns(Colonne).DataBodyRange.HorizontalAlignment = AlignementHorizontal
' L'en-tête:
If (Aligner And TS_Aligner_Entete) > 0 Then _
TS.ListObject.ShowHeaders = True: TS.ListObject.HeaderRowRange(Colonne).HorizontalAlignment = AlignementHorizontal

' Le total:
If (Aligner And TS_Aligner_Total) > 0 Then _
TS.ListObject.ShowTotals = True: TS.ListObject.ListColumns(Colonne).Total.HorizontalAlignment = AlignementHorizontal

End If

' Alignement vertical de la colonne:
If AlignementVertical <> -1 Then

' Les données:
If (Aligner And TS_Aligner_Données) > 0 Then _
TS.ListObject.ListColumns(Colonne).DataBodyRange.VerticalAlignment = AlignementVertical

' L'en-tête:
If (Aligner And TS_Aligner_Entete) Then _
TS.ListObject.ShowHeaders = True: TS.ListObject.HeaderRowRange(Colonne).VerticalAlignment = AlignementVertical

' Le total:
If (Aligner And TS_Aligner_Total) > 0 Then _
TS.ListObject.ShowTotals = True: TS.ListObject.ListColumns(Colonne).Total.VerticalAlignment = AlignementVertical

End If

' Renvoie VRAI:
TS_Aligner = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_Aligner", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_Aligner"
End If
Err.Clear

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

III - Trier, filtrer les données d’un tableau structuré

Les différentes fonctions de ce chapitre permettent de trier et filtrer les données d’un tableau structuré.

III-A - TS_TrierUneColonne

La fonction TS_TrierUneColonne trie la colonne passée en argument, en tenant compte de la casse.
Les lignes masquées sont ignorées dans le tri.
Si l’option d’affichage de la ligne bouton de filtre n’était pas active elle le devient automatiquement par l’appel à cette fonction.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou zéro, alors la dernière colonne du tableau est traitée ;

- Méthode : (facultatif) le paramètre de tri des données de l’énumération XlSortOn
- xlSortOnValues : (par défaut) trie suivant les valeurs,
- xlSortOnCellColor : trie suivant la couleur des cellules,
- xlSortOnFontColor : trie suivant la couleur de police ;

- Ordre : (facultatif) l’ordre de tri de l’énumération XlSortOrder
- xlAscending : (par défaut) ordre croissant,
- xlDescending : ordre décroissant ;

- EffacerAncienTri : (facultatif) si True (par défaut) alors efface l'ancien tri, si False alors ajoute le tri à celui existant.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour trier les élèves par nom et prénom, dans l’ordre croissant :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")

Call TS_TrierUneColonne(TS:=Tableau, Colonne:="Nom", Méthode:=xlSortOnValues, Ordre:=xlAscending, _
EffacerAncienTri:=True)

Call TS_TrierUneColonne(TS:=Tableau, Colonne:="Prénom", Méthode:=xlSortOnValues, Ordre:=xlAscending, _
EffacerAncienTri:=False)
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_TrierUneColonne(TS As Range, _
ByVal Colonne As Variant, _
Optional Méthode As XlSortOn = xlSortOnValues, _
Optional Ordre As XlSortOrder = xlAscending, _
Optional EffacerAncienTri As Boolean = True) As Boolean
'------------------------------------------------------------------------------------------------
' Trie une colonne d'un Tableau Structuré. La casse est prise en compte.
' Attention, les lignes masquées sont ignorées dans le tri.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne à trier.
'           Si 0 ou vide alors trie la dernière colonne du Tableau Structuré.
' Paramètre de tri des données:
' xlSortOnValues = les valeurs.
' xlSortOnCellColor = couleur de cellule.
' xlSortOnFontColor = couleur de police.
' Ordre du tri :
' xlAscending = Croissant.
' xlDescending = Décroissant.
' EffacerAncienTri : Si Vrai alors efface l'ancien tri, sinon ajoute le tri à celui existant.
'-----------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'----------------------------------------------------------------------------------------
' Exemple d'utilisation pour trier par ordre croissant un tableau par nom et prénom (en deux étapes):
' TS_TrierUneColonne(Range("TS_x"), "Nom")
' TS_TrierUneColonne(Range("TS_x"),"Prénom",,, False)
'----------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Retrouve le nom de la colonne:
Colonne = TS.ListObject.ListColumns(Colonne).Name

' Force l'affichage de l'option Bouton de filtre:
TS.ListObject.ShowHeaders = True
On Error GoTo Poser_Filtre
TS.ListObject.ShowAutoFilterDropDown = True
On Error GoTo 0

' S'il faut effacer tous les anciens tris ou juste
' le tri sur la colonne concerné pour pouvoir en mettre un nouveau:
If EffacerAncienTri = True Then
Call TS_EffacerTri(TS, "")
Else
Call TS_EffacerTri(TS, Colonne)
End If

' Pose le tri sur la colonne:
TS.ListObject.Sort.SortFields.Add Range(TS.ListObject.DisplayName & "[" & Colonne & "]"), Méthode, Ordre
TS.ListObject.Sort.Apply
TS_TrierUneColonne = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_TrierUneColonne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_TrierUneColonne"
End If
Err.Clear

Exit Function
Poser_Filtre:
TS.ListObject.Range.AutoFilter
Resume Next

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

III-B - TS_EffacerTri

La fonction TS_EffacerTri efface le tri de la colonne passée en argument ou de toutes les colonnes.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si cet argument vaut zéro alors la dernière colonne du tableau est traitée. S’il est vide alors tous les tris sont effacés.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour effacer tous les tris du tableau des élèves :

‘------------------------------------------------------------------------------------------------
Sub Exemple()
‘------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_EffacerTri(TS:=Tableau, Colonne:="")
End Sub
‘------------------------------------------------------------------------------------------------

Remarque : le fait d’effacer les tris n’a pas d’incidence sur l’ordre d’affichage du tableau structuré.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_EffacerTri(TS As Range, ByVal Colonne As Variant) As Boolean
'------------------------------------------------------------------------------------------------
' Efface le tri d'une colonne (ou de toutes les colonnes) d'un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne à effacer le tri.
'           Si 0 alors efface le tri de la dernière colonne du Tableau Structuré.
'           Si vide alors efface tous les tris.
'-----------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'----------------------------------------------------------------------------------------
Dim i As Integer, x As Integer

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

' S'il faut effacer tous les tris:
If Colonne = "" Then
On Error Resume Next
TS.ListObject.Sort.SortFields.Clear
Err.Clear
Else ' S'il faut effacer le tri d'une colonne:
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
' Retrouve le nom de la colonne:
Colonne = TS.ListObject.ListColumns(Colonne).Name
' boucle sur les tris existants:
For i = 1 To TS.ListObject.Sort.SortFields.Count
' Récupère le numéro de la colonne concernée:
x = TS.ListObject.Sort.SortFields(i).Key.Column - TS.Column + 1
' Si c'est la colonne à traiter alors supprime le tri:
If UCase(TS.ListObject.ListColumns(x).Name) = UCase(Colonne) Then
TS.ListObject.Sort.SortFields(i).Delete
TS.ListObject.Sort.Apply
Exit For
End If
Next i
End If

' Renvoie Vrai:
TS_EffacerTri = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_EffacerTri", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_EffacerTri"
End If
Err.Clear

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

III-C - TS_Filtres_Existe

La fonction TS_Filtres_Existe renseigne si le tableau structuré passé en argument est filtré ou non, ou si une colonne particulière du tableau est filtrée.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : (facultatif, vide par défaut) le nom ou le numéro de la colonne qu'il faut analyser. Si cet argument vaut zéro alors la dernière colonne du tableau est traitée. S’il est vide alors tout le tableau est analysé.

La fonction renvoie True :
- si le tableau a au moins un filtre actif et que l'argument « Colonne » est vide,
- si la colonne indiquée est filtrée.
Ou False dans le cas contraire.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_Filtres_Existe(TS As Range, Optional ByVal Colonne As Variant) As Boolean
'-----------------------------------------------------------------------------------------------
' Indique si un Tableau Structuré est filtré ou non, ou si une colonne est filtrée ou non.
'-----------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Une colonne spécifique ou vide s'il faut analyser tout le tableau.
'-----------------------------------------------------------------------------------------------
' Renvoie : Vrai si le tableau a au moins un filtre actif et que l'argument Colonne est vide.
'           Vrai si la Colonne indiquée est filtrée.
'           Faux dans les autres cas.
'-----------------------------------------------------------------------------------------------
Dim f As Integer

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

' Si une colonne particulière est à analyser:
If IsMissing(Colonne) = True Then Colonne = ""
If Colonne <> "" Then
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
End If

' Boucle sur les filtres du tableau pour savoir s'ils sont actifs ou non:
With TS.ListObject.AutoFilter.Filters
For f = 1 To .Count
If .Item(f).On Then
TS_Filtres_Existe = True
Exit For
End If
Next
' S'il ne faut analyser qu'une seule colonne:
If Val(Colonne) > 0 Then TS_Filtres_Existe = .Item(Colonne).On
End With

' Fin du traitement:
Gest_Err:
If Err.Number = 91 Then Err.Clear
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_Filtres_Existe", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_Filtres_Existe"
End If
Err.Clear

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

III-D - TS_Filtres_Poser

La fonction TS_Filtres_Poser pose un filtre sur une colonne du tableau structuré.
Le filtre peut contenir un ou deux critères.
Les critères ne sont pas sensibles à la casse.
Pour filtrer une date vous devrez convertir la date de référence au format "année/mois/jour". Et curieusement pour filtrer sur un même jour vous devrez utiliser deux opérateurs (inférieur ou égal et supérieur ou égal) car égal ne fonctionne pas. Voir l'exemple dans le code de la fonction.
Si l’option d’affichage de l’option bouton de filtre n’était pas active, elle le devient automatiquement par l’appel à cette fonction.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou zéro, alors la dernière colonne du tableau est traitée ;

- Critère1 : le premier critère, à laisser vide pour effacer le filtre ;

- Opérateur : (facultatif) l'opérateur logique s’il y a deux critères de l’énumération XlAutoFilterOperator(1)
- xlAnd : opérateur logique « Et »,
- XlOr : opérateur logique « Ou » ;

- Critère2 : (facultatif) le second critère.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour filtrer dans le tableau des élèves les notes supérieures à 10, les noms commençant par les lettres « T » ou « C », les prénoms « Alex » ou « Sarah » ou « Toto » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_Filtres_Poser(Tableau, "Note", ">10")
Call TS_Filtres_Poser(Tableau, "Nom", "=t*", xlOr, "=c*")
Call TS_Filtres_Poser(Tableau, "Prénom", Array("alex", "sarah", "toto"))
End Sub
'------------------------------------------------------------------------------------------------

Exemple pour supprimer tous ces filtres :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_Filtres_Poser(Tableau, "Nom", "")
Call TS_Filtres_Poser(Tableau, "prénom", "")
Call TS_Filtres_Poser(Tableau, "note", "")
End Sub
'------------------------------------------------------------------------------------------------

Remarque : pour supprimer les filtres d’une colonne ou du tableau structuré, vous pouvez aussi utiliser la fonction TS_Filtres_Effacer, voir ci-après.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_Filtres_Poser(TS As Range, _
ByVal Colonne As Variant, _
ByVal Critère1 As Variant, _
Optional Opérateur As XlAutoFilterOperator, _
Optional Critère2 As String = "") As Boolean
'------------------------------------------------------------------------------------------------
' Pose un filtre sur une colonne d'un Tableau Structuré.
' Pour plus d'informations :
' https://docs.microsoft.com/fr-fr/office/vba/api/excel.range.autofilter
' https://excel.developpez.com/faq/?page=Filtre
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Critère1 : le premier critère. Laissez à vide pour effacer le filtre
' Opérateur : l'opérateur logique.
' Critère2 : le second critère.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Exemples:
' TS_Filtres_Poser(range("TS_Eleves"),"Note",">10") pour les notes supérieures à 10.
' TS_Filtres_Poser(range("TS_Eleves"),"Nom","=m*", xlor, "=l*") pour les noms qui commencent par m ou l.
' TS_Filtres_Poser(range("TS_Eleves"),"Nom",Array("marx", "toto", "tini")) pour sélectionner certaines valeurs.
' TS_Filtres_Poser(range("TS_Eleves"),"Nom","") pour effacer le filtre sur le champ "Nom".
' Curieusement pour une date (à mettre au format année/mois/jour) il faut utiliser deux opérateurs,
' même pour filtrer un seul jour:
' TS_Filtres_Poser(range("TS_Eleves"),"Quand", ">=" & Year(Date) & "/" & Month(Date) & "/" & Day(Date), _
'                                       xlAnd, "<=" & Year(Date) & "/" & Month(Date) & "/" & Day(Date)
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Si c'est un Array qui est passé en Critère 1:
If IsArray(Critère1) = True Then
TS.ListObject.Range.AutoFilter field:=Colonne, Criteria1:=Array(Critère1), Operator:=xlFilterValues

' Si les critères sont des chaînes de caractères:
Else

' S'il faut effacer un filtre:
If Critère1 = "" Then Critère1 = Null

' S'il n'y a qu'un seul critère:
If Critère2 = "" Then
TS.ListObject.Range.AutoFilter field:=Colonne, Criteria1:=Critère1
' S'il y a deux critères:
Else
TS.ListObject.Range.AutoFilter field:=Colonne, Criteria1:=Critère1, Operator:=Opérateur, Criteria2:=Critère2
End If

End If

TS_Filtres_Poser = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_Filtres_Poser", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_Filtres_Poser"
End If
Err.Clear

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

III-E - TS_Filtres_Effacer

La fonction TS_Filtres_Effacer efface le filtre d’une colonne ou de toutes les colonnes d’un tableau structuré.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si cet argument vaut zéro, alors la dernière colonne du tableau est traitée. S’il est non renseigné ou vide, alors tous les filtres sont effacés.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour effacer tous les filtres du tableau des élèves :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_Filtres_Effacer(Tableau)
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_Filtres_Effacer(TS As Range, Optional Colonne As Variant) As Boolean
'------------------------------------------------------------------------------------------------
' Efface le filtre d'une colonne ou de toutes les colonnes d'un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne à effacer le filtre.
'           Si 0 alors efface le filtre de la dernière colonne du Tableau Structuré.
'           Si vide ou non renseigné alors efface tous les filtres.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' S'il faut effacer tous les filtres:
If IsMissing(Colonne) = True Then Colonne = ""
If Colonne = "" Then
On Error Resume Next
TS.ListObject.AutoFilter.ShowAllData
Err.Clear
TS_Filtres_Effacer = True
Else ' S'il faut effacer le filtre d'une colonne:
If TS_Filtres_Poser(TS, Colonne, "") = False Then
Err.Raise TS_Err_Number, , TS_Err_Description
Else
TS_Filtres_Effacer = True
End If
End If

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_Filtres_Effacer", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_Filtres_Effacer"
End If
Err.Clear

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

III-F - TS_Filtres_Mémoriser

La fonction TS_Filtres_Mémoriser mémorise dans une variable les filtres d’un tableau structuré.
Ce traitement permettra de les restituer ultérieurement, voir la fonction TS_Filtres_Restaurer.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Mémoire : la mémoire à utiliser.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour mémoriser les filtres du tableau des élèves :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Dim MesFiltres As Variant
Call TS_Filtres_Mémoriser(Tableau, MesFiltres)
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_Filtres_Mémoriser(TS As Range, Mémoire As Variant) As Boolean
'-----------------------------------------------------------------------------------------------
' Mémorise les filtres d'un Tableau Structuré.
'-----------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Mémoire : la mémoire à utiliser.
'-----------------------------------------------------------------------------------------------
' Renvoie : vrai si le tableau a au moins un filtre actif.
'-----------------------------------------------------------------------------------------------
Dim f As Integer

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

' Boucle sur les filtres du tableau:
With TS.ListObject.AutoFilter.Filters
ReDim Mémoire(1 To .Count, 1 To 3)
For f = 1 To .Count
With .Item(f)
If .On Then
TS_Filtres_Mémoriser = True
Mémoire(f, 1) = .Criteria1
If .Operator Then
Mémoire(f, 2) = .Operator
Mémoire(f, 3) = .Criteria2
End If
End If
End With
Next
End With

' Fin du traitement:
Gest_Err:
Err.Clear

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

III-G - TS_Filtres_Restaurer

La fonction TS_Filtres_Restaurer restaure les filtres préalablement mémorisés dans une variable par la fonction TS_Filtres_Mémoriser.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Mémoire : la mémoire à utiliser.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour mémoriser les filtres du tableau des élèves, les effacer pour poser un nouveau filtre sur les notes supérieures à 10, afficher le nombre de ces notes, puis restaurer l’ancienne situation :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range, MesFiltres As Variant
Set Tableau = Range("TS_Eleves")
Call TS_Filtres_Mémoriser(Tableau, MesFiltres)
Call TS_Filtres_Effacer(Tableau)
Call TS_Filtres_Poser(Tableau, "Note", ">10")
Call TS_DéfinirTotaux(Tableau, "note", xlTotalsCalculationCountNums)
MsgBox "Nombre de notes > 10"
Call TS_Filtres_Restaurer(Tableau, MesFiltres)
Call TS_OptionsStyle(Tableau, Ligne_Totaux:=False)
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_Filtres_Restaurer(TS As Range, Mémoire As Variant) As Boolean
'-----------------------------------------------------------------------------------------------
' Restaure les filtres d'un Tableau Structuré préalablement mémorisés avec TS_Filtres_Mémoriser.
'-----------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Mémoire : la mémoire à utiliser.
'-----------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'-----------------------------------------------------------------------------------------------
Dim f As Integer

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

For f = 1 To UBound(Mémoire, 1)
If Not IsEmpty(Mémoire(f, 1)) Then
If Mémoire(f, 2) Then
TS.ListObject.Range.AutoFilter field:=f, _
Criteria1:=Mémoire(f, 1), _
Operator:=Mémoire(f, 2), _
Criteria2:=Mémoire(f, 3)
Else
TS.ListObject.Range.AutoFilter field:=f, Criteria1:=Mémoire(f, 1)
End If
End If
Next

' Fin du traitement:
TS_Filtres_Restaurer = True

Gest_Err:
Err.Clear

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

III-H - TS_CouleurLigneChangeValeur

La fonction TS_CouleurLigneChangeValeur alterne la couleur de fond des lignes visibles d'un tableau structuré à chaque changement de valeur dans la colonne de votre choix.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si le numéro est zéro, alors la dernière colonne du tableau est traitée. Si ce nom est vide ou -1 (valeur par défaut), alors efface toutes les couleurs des lignes visibles ;

- CoulA : le numéro de la première couleur, ou -1 (valeur par défaut) pour ne pas appliquer de couleur ;

- CoulB : le numéro de la seconde couleur, ou -1 (valeur par défaut) pour ne pas appliquer de couleur.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour alterner la couleur des lignes d'un tableau à chaque changement de Note :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves_1")
Call TS_CouleurLigneChangeValeur(TS:=Tableau, Colonne:="Note", CoulA:=14277081, CoulB:=14348258)

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

Pour effacer les couleurs personnelles (sur les lignes visibles) et restaurer les couleurs par défaut du tableau structuré, ne renseignez pas l'argument "Colonne" de la fonction :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves_1")
Call TS_CouleurLigneChangeValeur(TS:=Tableau)

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

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_CouleurLigneChangeValeur(TS As Range, Optional ByVal Colonne As Variant = -1, _
Optional ByVal CoulA As Long = xlNone, _
Optional ByVal CoulB As Long = xlNone) As Boolean
'------------------------------------------------------------------------------------------------
' Alterne la couleur de fond des lignes d'un tableau structuré à chaque changement de valeur dans la
' colonne de votre choix. Ou supprime toutes les couleurs des lignes visibles.
' Le tableau doit avoir au moins deux lignes.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si 0 alors prend la dernière colonne du Tableau Structuré.
'           Si vide ou -1 (valeur par défaut) alors efface toutes les couleurs des lignes visibles.
' CoulA : La première couleur à appliquer (sans couleur par défaut).
' CoulB : La seconde couleur à appliquer (sans couleur par défaut).
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim y As Long
Dim AncValeur As Variant
Dim Coul As Long
Dim Anc_ScreenUpdating As Boolean
Dim Anc_Cursor As Long

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

' Bloque les mises à jour de l'écran:
Anc_Cursor = Application.Cursor
Application.Cursor = xlWait
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' S'il faut effacer toutes les couleurs des lignes visibles:
If Colonne = -1 Then
TS.ListObject.DataBodyRange.Interior.Color = xlNone
GoTo Gest_Err
End If

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Si le tableau à moins de 2 lignes alors ne rien faire:
If TS_Nombre_Lignes(TS) < 2 Then GoTo Gest_Err

' Boucle sur les lignes:
For y = 1 To TS_Nombre_Lignes(TS)

' Si la ligne est visible:
If TS.ListObject.DataBodyRange(y, 1).Height > 0 Then
' Si la valeur à changé alors change la couleur de fond a appliquer:
If TS.ListObject.DataBodyRange(y, Colonne).Value <> AncValeur Then
If Coul = CoulA Then Coul = CoulB Else Coul = CoulA
End If
' Pose la couleur de fond pour la ligne:
TS.ListObject.DataBodyRange.Rows(y).Interior.Color = Coul
' Mémorise la dernière valeur visible:
AncValeur = TS.ListObject.DataBodyRange(y, Colonne).Value
End If

Next y

' Renvoie VRAI:
TS_CouleurLigneChangeValeur = True

' Fin du traitement:
Gest_Err:
Application.Cursor = Anc_Cursor
Application.ScreenUpdating = Anc_ScreenUpdating

TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_CouleurLigneChangeValeur", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_CouleurLigneChangeValeur"
End If
Err.Clear

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

IV - Obtenir des informations sur les données d’un tableau structuré

Les deux premières fonctions de ce chapitre permettent d’obtenir des informations sur les dimensions d’un tableau structuré. Les deux suivantes renvoient des informations sur ses données.

IV-A - TS_Nombre_Lignes

La fonction TS_Nombre_Lignes renvoie le nombre de lignes du tableau structuré passé en argument.

Son argument est :

- TS : la plage (de type Range) qui représente le tableau structuré.

La fonction renvoie : le nombre de lignes du tableau structuré, donc zéro s’il est vide.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_Nombre_Lignes(TS As Range) As Long
'------------------------------------------------------------------------------------------------
TS_Nombre_Lignes = TS.ListObject.ListRows.Count

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

IV-B - TS_Nombre_Colonnes

La fonction TS_Nombre_Colonnes renvoie le nombre de colonnes du tableau structuré passé en argument.

Son argument est :

- TS : la plage (de type Range) qui représente le tableau structuré.

La fonction renvoie : le nombre de colonnes du tableau structuré.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_Nombre_Colonnes(TS As Range) As Integer
'------------------------------------------------------------------------------------------------
TS_Nombre_Colonnes = TS.ListObject.ListColumns.Count

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

IV-C - TS_ValeurColonne

La fonction TS_ValeurColonne renvoie la valeur du calcul pour la ligne des totaux d'une colonne d’un tableau structuré.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou zéro alors la dernière colonne du tableau est traitée ;

- TypeCalcul : une valeur de l’énumération XlTotalsCalculation
- xlTotalsCalculationAverage : moyenne,
- xlTotalsCalculationCount : décompte des cellules non vides,
- xlTotalsCalculationCountNums : décompte des cellules contenant des valeurs numériques,
- xlTotalsCalculationMax : valeur maximale dans la liste,
- xlTotalsCalculationMin : valeur minimale dans la liste,
- xlTotalsCalculationStdDev : calcul l’écart-type standard,
- xlTotalsCalculationSum : somme,
- xlTotalsCalculationVar = (personalisé) nombre de cellules non numériques,
- xlTotalsCalculationNone = (personnalisé) nombre de cellules vides ;

- CellulesVisiblesUniquement : True pour ne pour ne traiter que les cellules visibles, False pour traiter toutes les cellules (y compris les filtrées et masquées).

La fonction renvoie : la valeur du calcul demandé ou Null si erreur.

Exemple pour obtenir la note moyenne des élèves (y compris les éléments filtrés) :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Dim Moyenne As Double
Moyenne = TS_ValeurColonne(Tableau, "Note", xlTotalsCalculationAverage, False)
End Sub
'------------------------------------------------------------------------------------------------

Remarque : vous pouvez aussi utiliser les fonctions d'Excel, par exemple :
Application.Evaluate("=COUNTIF(Tableau[Note],"">10"")") : nombre de notes supérieures à 10.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ValeurColonne(TS As Range, _
ByVal Colonne As Variant, _
TypeCalcul As XlTotalsCalculation, _
CellulesVisiblesUniquement As Boolean) As Variant
'------------------------------------------------------------------------------------------------
' Renvoie la valeur d'une colonne.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' TypeCalcul : Type de calcul à appliquer suivant l'énumération XlTotalsCalculation.
'   xlTotalsCalculationAverage = Moyenne.
'   xlTotalsCalculationCount = Nombre de cellules non vides.
'   xlTotalsCalculationCountNums = Nombre de cellules avec des valeurs numériques.
'   xlTotalsCalculationMax = Valeur numérique maximale.
'   xlTotalsCalculationMin = Valeur numérique minimale.
'   xlTotalsCalculationStdDev = Écart type standard.
'   xlTotalsCalculationSum = Somme.
'   xlTotalsCalculationVar = (Personnalisé) Nombre de cellules non numériques.
'   xlTotalsCalculationNone = (personnalisé) Nombre de cellules vides.
' CellulesVisiblesUniquement : VRAI pour ne calculer que les cellules visibles.
'------------------------------------------------------------------------------------------------
' Renvoie : la valeur concernée en prenant en compte les lignes filtrées ou non, au choix,
'           ou Null si erreur (valeur non numérique).
'------------------------------------------------------------------------------------------------
Dim CalculationNone As Long
Dim CalculationVar As Long
Dim PlageCalcul As Range, Fx As Integer
Dim Ligne As Long

On Error GoTo Gest_Err
Err.Clear

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Par défaut renvoyer Null:
TS_ValeurColonne = Null

' S'il faut calculer les cellules visibles uniqement (non filtrées) pour les 7 opérateurs classiques,
' il est possible d'utiliser Application.Subtotal:
If CellulesVisiblesUniquement = True Then

' Définit la plage de calcul:
Set PlageCalcul = TS.ListObject.ListColumns(Colonne).DataBodyRange

Select Case TypeCalcul
Case xlTotalsCalculationAverage:    Fx = 1
Case xlTotalsCalculationCount:      Fx = 3
Case xlTotalsCalculationCountNums:  Fx = 2
Case xlTotalsCalculationMax:        Fx = 4
Case xlTotalsCalculationMin:        Fx = 5
Case xlTotalsCalculationStdDev:     Fx = 7
Case xlTotalsCalculationSum:        Fx = 9
End Select

If Fx <> 0 Then TS_ValeurColonne = Application.Subtotal(Fx, PlageCalcul)

End If

' S'il faut calculer toutes les cellules (y compris les filtrées) pour les 7 opérateurs
' classiques, et xlTotalsCalculationNone, il est possible d'utiliser les fonctions "Application":
If CellulesVisiblesUniquement = False Then

' Définit la plage de calcul:
Set PlageCalcul = TS.ListObject.ListColumns(Colonne).DataBodyRange

Select Case TypeCalcul
Case xlTotalsCalculationAverage:    TS_ValeurColonne = Application.Average(PlageCalcul)
Case xlTotalsCalculationCount:      TS_ValeurColonne = Application.CountA(PlageCalcul)
Case xlTotalsCalculationCountNums:  TS_ValeurColonne = Application.Count(PlageCalcul)
Case xlTotalsCalculationMax:        TS_ValeurColonne = Application.Max(PlageCalcul)
Case xlTotalsCalculationMin:        TS_ValeurColonne = Application.Min(PlageCalcul)
Case xlTotalsCalculationStdDev:     TS_ValeurColonne = Application.StDev(PlageCalcul)
Case xlTotalsCalculationSum:        TS_ValeurColonne = Application.Sum(PlageCalcul)
Case xlTotalsCalculationNone:       TS_ValeurColonne = Application.CountBlank(PlageCalcul)
End Select

End If

' Pour les cas personnalisés :
'   xlTotalsCalculationVar = Nombre de cellules non numériques.
'   xlTotalsCalculationNone = Nombre de cellules vides.
If IsNull(TS_ValeurColonne) Then

' Boucle sur les données de la colonne:
For Ligne = 1 To TS.ListObject.ListRows.Count
' Traitement de la cellule de la colonne:
With TS.ListObject.DataBodyRange(Ligne, Colonne)
' Si la ligne est visible ou non (sa hauteur vaut 0) et suivant le cas demandé:
If (.Height <> (CellulesVisiblesUniquement Xor -1)) Then
' Si la ligne est non vide:
If .Value <> "" Then
' Si la cellule n'est pas numérique:
If IsNumeric(.Value) = False Then CalculationVar = CalculationVar + 1
Else
' Si la cellule est vide:
CalculationNone = CalculationNone + 1
End If
End If
End With
Next Ligne

' Renvoie le résultat suivant le calcul demandé:
Select Case TypeCalcul
Case xlTotalsCalculationNone
TS_ValeurColonne = CalculationNone
Case xlTotalsCalculationVar
TS_ValeurColonne = CalculationVar
End Select

End If

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ValeurColonne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ValeurColonne"
End If
Err.Clear

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

IV-D - TS_InfoCellule

La fonction TS_InfoCellule renvoie des informations sur une cellule d’un tableau structuré, même si elle est masquée.

La cellule concernée est identifiée par sa position dans le tableau structuré. La première colonne vaut 1 (il est conseillé d’utiliser le nom de la colonne au lieu de son numéro), la première ligne vaut 1.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou zéro alors la dernière colonne du tableau est traitée ;

- Ligne : la ligne concernée. Si cette valeur est zéro alors prend la dernière ligne du tableau structuré. Si elle est inférieure à zéro alors prend la ligne des totaux ;

- TypeInfo : (facultatif) le type d’information désirée défini par une valeur de l’énumération personnelle Enum_InfoTS déclarée en en-tête du module
- TS_Valeur : (par défaut) renvoie la valeur de la cellule,
- TS_Formule : renvoie la formule de la cellule,
- TS_CouleurTexte : renvoie la couleur de texte de la cellule,
- TS_CouleurFond : renvoie la couleur de fond de la cellule,
- TS_Gras : renvoie True si la cellule est en gras et False dans le cas contraire,
- TS_Italique : renvoie True si la cellule est en italique et False dans le cas contraire,
- TS_Visible : renvoie True si la cellule est visible et False dans le cas contraire,
- TS_Format : renvoie le format de la cellule,
- TS_Commentaire : renvoie le commentaire de la cellule,
- TS_LienHypertexte : renvoie le lien hypertexte de la cellule.

La fonction renvoie l’information sur la cellule suivant l’option demandée, même si elle est masquée.

Exemple pour boucler sur les lignes du tableau structuré « TS_Eleves » et afficher dans le débogueur leur note :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Dim Ligne As Long
For Ligne = 1 To TS_Nombre_Lignes(Tableau)
Debug.Print TS_InfoCellule(Tableau, "Note", Ligne, TS_Valeur)
Next Ligne
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_InfoCellule(TS As Range, _
ByVal Colonne As Variant, _
ByVal Ligne As Long, _
Optional TypeInfo As Enum_InfoTS = TS_Valeur) As Variant
'------------------------------------------------------------------------------------------------
' Renvoie une information sur la cellule d'une ligne d'une colonne (même si elle est masquée).
' L'information peut être la valeur ou la formule ou la couleur du texte...
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Ligne : la ligne concernée.
'         Si 0 alors prend la dernière ligne du Tableau Structuré.
'         Si <0 alors prend la ligne des totaux.
' TypeInfo : type d'information à renvoyer, voir l'énumération Enum_InfoTS.
'            TS_Valeur       : renvoie la valeur de la cellule.
'            TS_Formule      : renvoie la formule de la cellule.
'            TS_CouleurTexte : renvoie la couleur de texte de la cellule.
'            TS_CouleurFond  : renvoie la couleur de fond de la cellule.
'            TS_Gras         : renvoie Vrai si la cellule est en gras.
'            TS_Italique     : renvoie Vrai si la cellule est en italique.
'            TS_Visible      : renvoie Vrai si la cellule est visible.
'            TS_Format       : renvoie le format de la cellule.
'            TS_Commentaire  : renvoie le commentaire de la cellule.
'            TS_LienHypertexte : renvoie le lien hypertexte de la cellule.
'------------------------------------------------------------------------------------------------
' Renvoie l'information désirée sur la cellule.
'------------------------------------------------------------------------------------------------
Dim Anc_ShowTotals As Boolean
Dim Anc_ScreenUpdating As Boolean

On Error GoTo Gest_Err
Err.Clear

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Contrôle la cohérence de la ligne passée en argument:
If Ligne >= 0 Then
Ligne = TS_IndexLigne(TS, Ligne)
If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
End If

' S'il faut traiter les totaux alors force l'affichage des totaux:
If Ligne < 0 Then
Anc_ShowTotals = TS.ListObject.ShowTotals
Anc_ScreenUpdating = Application.ScreenUpdating
Ligne = TS.ListObject.ListRows.Count + 1
Application.ScreenUpdating = False
TS.ListObject.ShowTotals = True
End If

' Traitement:
With TS.ListObject.DataBodyRange(Ligne, Colonne)
Select Case TypeInfo
Case TS_valeur
TS_InfoCellule = .Value
Case TS_Formule
TS_InfoCellule = .Formula
Case TS_CouleurTexte
TS_InfoCellule = .Font.Color
Case TS_CouleurFond
TS_InfoCellule = .Interior.Color
Case TS_Gras
TS_InfoCellule = .Font.Bold
Case TS_Italique
TS_InfoCellule = .Font.Italic
Case TS_Visible
If .Height > 0 Then TS_InfoCellule = True Else TS_InfoCellule = False
Case TS_Format
TS_InfoCellule = .NumberFormat
Case TS_Commentaire
If Not .Comment Is Nothing Then
TS_InfoCellule = .Comment.Text
End If
Case TS_LienHypertexte
If .Hyperlinks.Count > 0 Then
TS_InfoCellule = .Hyperlinks(1).Name
End If
End Select
End With

' Restaure l'état de l'affichage des totaux:
If Ligne > TS.ListObject.ListRows.Count Then
TS.ListObject.ShowTotals = Anc_ShowTotals
Application.ScreenUpdating = Anc_ScreenUpdating
End If

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_InfoCellule", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_InfoCellule"
End If
Err.Clear

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

V - Rechercher, sélectionner, modifier les données d’un tableau structuré

Les différentes fonctions de ce chapitre permettent de rechercher, sélectionner ou modifier les données d’un tableau structuré.

V-A - TS_Rechercher

La fonction TS_Rechercher recherche une donnée et renvoie le numéro de la ligne où elle se trouve.
La recherche peut comporter jusqu’à 16 colonnes dans ses critères.
Les lignes masquées sont incluses dans la recherche.
Les critères peuvent être passés « en dur » ou par un tableau.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- RespecterCasse : True pour respecter la casse ou False pour l’ignorer ;

- ListeColonnesValeurs : la liste des colonnes et valeurs de type ParamArray (tableau de paramètres), séparées par une virgule.

La fonction renvoie : le numéro de la ligne qui correspond aux critères de recherche ou zéro si rien n’est trouvé.

Exemple pour rechercher la ligne où se trouve l’élève dont le nom est « TINE » et le prénom « Clément » (en respectant la casse) :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Dim Ligne As Long
Ligne = TS_Rechercher(Tableau, True, "Nom", "TINE", "Prénom", "Clément")
End Sub
'------------------------------------------------------------------------------------------------

Exemple pour rechercher la même chose mais les critères sont passés en utilisant un tableau :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Dim Ligne As Long
Dim T(1 To 4) As Variant
T(1) = "Nom"
T(2) = "TINE"
T(3) = "Prénom"
T(4) = "Clément"
Ligne = TS_Rechercher(Tableau, True, T)
End Sub
'------------------------------------------------------------------------------------------------

Remarque : pour une recherche de date, pensez à convertir la date en valeur par l’instruction DateValue(MaDate)

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_Rechercher(TS As Range, _
RespecterCasse As Boolean, _
ParamArray ListeColonnesValeurs() As Variant) As Long
'-----------------------------------------------------------------------------------------------
' Recherche une valeur dans un Tableau Structuré.
'-----------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' RespecterCasse As Boolean : True pour respecter la casse ou False pour l'ignorer.
' ListeColonnesValeurs : La liste des colonnes et valeurs de type ParamArray (tableau de paramètres).
' Un ParamArray est limité à 32 arguments (séparés par une virgule), donc 16 couples.
'-----------------------------------------------------------------------------------------------
' Renvoie : la 1ère ligne trouvée ou 0 si rien n'est trouvé.
'------------------------------------------------------------------------------------------------
Dim i As Integer, Ligne As Long, ik As Integer, Trouvé As Boolean
Dim Arguments() As Variant
Dim Colonne() As Variant
Dim Valeur() As Variant

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

' Si ListeColonnesValeurs est passé en programmation:
If UBound(ListeColonnesValeurs) = 0 Then
ReDim Arguments(LBound(ListeColonnesValeurs(0)) To UBound(ListeColonnesValeurs(0)))
For ik = LBound(Arguments) To UBound(Arguments)
Arguments(ik) = ListeColonnesValeurs(0)(ik)
Next ik
End If

' Si ListeColonnesValeurs est passé en dure:
If UBound(ListeColonnesValeurs) > 0 Then
ReDim Arguments(LBound(ListeColonnesValeurs) To UBound(ListeColonnesValeurs))
For ik = LBound(Arguments) To UBound(Arguments)
Arguments(ik) = ListeColonnesValeurs(ik)
Next ik
End If

' Chargement des colonnes:
ik = LBound(Arguments)
For i = LBound(Arguments) To UBound(Arguments) Step 2
ReDim Preserve Colonne(LBound(Arguments) To ik)
Colonne(ik) = TS_IndexColonne(TS, Arguments(i))
If Colonne(ik) = -1 Then Err.Raise vbObjectError, , TS_Err_Description
ik = ik + 1
Next i

' Chargement des valeurs:
ik = LBound(Arguments)
For i = LBound(Arguments) To UBound(Arguments) Step 2
ReDim Preserve Valeur(LBound(Arguments) To ik)
Valeur(ik) = Arguments(i + 1)
If TypeName(Arguments(i + 1)) <> "String" Then Valeur(ik) = CDec(Valeur(ik))
ik = ik + 1
Next i

' Recherche dans toutes les lignes du Tableau Structuré les couples Colonne/valeur:
For Ligne = 1 To TS.ListObject.ListRows.Count

Trouvé = True

Select Case RespecterCasse
Case True
For i = LBound(Colonne) To UBound(Colonne)
If TS.ListObject.DataBodyRange(Ligne, Colonne(i)).Value <> Valeur(i) Then
Trouvé = False
Exit For
End If
Next i

Case False
For i = LBound(Colonne) To UBound(Colonne)
If UCase(TS.ListObject.DataBodyRange(Ligne, Colonne(i)).Value) <> UCase(Valeur(i)) Then
Trouvé = False
Exit For
End If
Next i
End Select

If Trouvé = True Then
TS_Rechercher = Ligne
Exit For
End If

Next Ligne

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_Rechercher", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_Rechercher"
End If
Err.Clear

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

V-B - TS_RechercherVisible

La fonction TS_RechercherVisible recherche une valeur dans une colonne d'un tableau structuré uniquement pour les lignes visibles et renvoie la ligne trouvée.
En option vous pouvez indiquer si la recherche doit respecter ou non la casse et s'il faut ou non une correspondance exacte.
Par défaut la fonction renvoie le numéro de la première ligne trouvée ou zéro si rien n’est trouvé, mais vous pouvez aussi lui demander de renvoyer la valeur de la colonne de votre choix (équivalent à RechercheV), ou la valeur à renvoyer si la recherche est infructueuse.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le numéro de la colonne ou le nom de la colonne concernée, ou 0 pour traiter la dernière colonne ;

- ValeurCherchée : la valeur qu'il faut chercher ;

- RespecterCasse : True pour respecter la casse ou False pour l’ignorer ;

- ValeursOuFormules : énumération Enum_ValeursOuFormules pour indiquer si la recherche porte sur la valeur de la cellule ou sur sa formule :
- TS_Valeurs : recherche dans les valeurs,
- TS_Formules ou TS_FormulesLocales : recherche dans les formules.

- Correspondance : (facultatif) indique le mode de recherche :
- xlWhole : (par défaut) détecte une correspondance avec l'ensemble du texte recherché,
- xlPart : détecte une correspondance avec une partie du texte recherché ;

- ColonneRenvoyée : (facultatif) le nom ou le numéro de la colonne concernée. Si ce numéro est zéro, alors la dernière colonne du tableau structuré est traitée ;

- ValeurSiNonTRouvé : (facultatif) la valeur à renvoyer si la recherche ne trouve rien.

La fonction renvoie :

- - si ColonneRenvoyée < 0 : Le numéro de la 1ère ligne trouvée ou 0 si rien n'est trouvé ;

- - si ColonneRenvoyée >= 0 : La valeur contenue dans la colonne indiquée pour la ligne trouvée, ou la valeur de l'argument ValeurSiNonTRouvé si rien n'est trouvé.

Exemple pour rechercher la ligne où se trouve l’élève dont le nom est « FIL » dans un tableau nommé « TS_Eleves » en respectant la casse :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Dim Ligne As Long
Ligne = TS_RechercherVisible(Tableau, "Nom", "FIL", True, TS_Valeurs)
End Sub
'------------------------------------------------------------------------------------------------

Remarque : Cette fonction est plus rapide que la fonction TS_Rechercher car elle utilise la propriété Find au lieu d'une boucle sur les lignes du tableau.
Elle permet aussi de ne faire la recherche que sur les lignes visibles. En contrepartie la recherche ne porte que sur une colonne.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_RechercherVisible(TS As Range, _
ByVal Colonne As Variant, _
ValeurCherchée As Variant, _
RespecterCasse As Boolean, _
ValeursOuFormules As Enum_ValeursOuFormules, _
Optional Correspondance As XlLookAt = xlWhole, _
Optional ByVal ColonneRenvoyée As Variant = -1, _
Optional ValeurSiNonTRouvé As Variant = "#N/A") As Variant
'-----------------------------------------------------------------------------------------------
' Recherche une valeur dans une colonne d'un Tableau Structuré uniquement pour les lignes visibles
' et renvoie la ligne trouvée.
' La recherche respecte la casse si RespecterCasse = True.
'-----------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' ValeurCherchée : La valeur recherchée.
' RespecterCasse As Boolean : True pour respecter la casse ou False pour l'ignorer.
' ValeursOuFormules : énumération Enum_ValeursOuFormules =
'                     TS_Valeurs : en valeurs.
'                     TS_Formules : en formules (idem pour TS_FormulesLocales).
' Correspondance : Indique le mode de recherche :
'                  xlPart : Détecte une correspondance avec une partie du texte recherché.
'                  xlWhole : Détecte une correspondance avec l'ensemble du texte recherché.
' ColonneRenvoyée : Si >=0 alors le numéro de la colonne, ou le nom de la colonne, dont il faut
'                   renvoyer le contenu.
'                   Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' ValeurSiNonTRouvé : La valeur renvoyée si l'élément recherché n'est pas trouvé.
'-----------------------------------------------------------------------------------------------
' Renvoie :
' Si ColonneRenvoyée < 0 : Le numéro de la 1ère ligne trouvée ou 0 si rien n'est trouvé.
' Si ColonneRenvoyée >= 0 : La valeur contenue dans la colonne indiquée pour la ligne trouvée,
'                           ou la valeur de l'argument ValeurSiNonTRouvé si rien n'est trouvé.
'------------------------------------------------------------------------------------------------
' Remarque : voir la documentation sur "Find" pour plus d'informations.
' https://learn.microsoft.com/fr-fr/office/vba/api/excel.xlfindlookin
'------------------------------------------------------------------------------------------------
' Exemple de recherche du nom "FIL" dans un tableau nommé "TS_X" et renvoyer la ligne concernée:
' Debug.Print TS_RechercherVisible(Range("TS_X"), "Nom", "FIL", True, TS_Valeurs)
' Exemple pour renvoyer dans la variable "X" la note de "TINE":
' X = TS_RechercherVisible(Range("TS_X"), "Nom", "TINE", True, TS_Valeurs, xlWhole, "Note", "Aucune note")
'------------------------------------------------------------------------------------------------
Dim Rg As Range
Dim Lookin As Long

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

' Valeur de renvoi par défaut:
TS_RechercherVisible = 0

' Recherche par formule ou valeur:
Select Case ValeursOuFormules
Case TS_Valeurs: Lookin = xlValues
Case Else: Lookin = xlFormulas
End Select

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Si au moins une ligne existe:
If TS.ListObject.ListRows.Count > 0 Then

' Lance la recherche avec Find:
Set Rg = TS.ListObject.ListColumns(Colonne).DataBodyRange.Find(What:=ValeurCherchée, MatchCase:=RespecterCasse, Lookin:=Lookin, LookAt:=Correspondance)
If Not Rg Is Nothing Then TS_RechercherVisible = Rg.Row - TS.Row + 1

' S'il faut renvoyer la valeur de la colonne de la ligne:
If ColonneRenvoyée >= 0 Then
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
ColonneRenvoyée = TS_IndexColonne(TS, ColonneRenvoyée)
If ColonneRenvoyée = -1 Then Err.Raise vbObjectError, , TS_Err_Description
' Suivant que l'élément recherché a été trouvé ou non:
Select Case TS_RechercherVisible
Case 0: TS_RechercherVisible = ValeurSiNonTRouvé
Case Else: TS_RechercherVisible = TS_InfoCellule(TS, ColonneRenvoyée, TS_RechercherVisible)
End Select
End If

End If

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_RechercherVisible", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_RechercherVisible"
End If
Err.Clear

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

V-C - TS_Remplacer

La fonction TS_Remplacer remplace une valeur dans une colonne d'un tableau structuré.
Attention :
- si le tableau est sur la feuille active les cellules masquées ne sont pas traitées ;
- si le tableau n'est pas sur la feuille active les cellules masquées sont traitées.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le numéro de la colonne ou le nom de la colonne concernée, ou 0 pour traiter la dernière colonne ;

- ValeurCherchée : la valeur qu'il faut remplacer ;

- ValeurRemplacement : la valeur de remplacement ;

- RespecterCasse : True pour respecter la casse ou False pour l’ignorer ;

- Correspondance : (facultatif) Indique le mode de recherche :
- xlPart : détecte une correspondance avec une partie du texte recherché,
- xlWhole : (valeur par défaut) détecte une correspondance avec l'ensemble du texte recherché.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour remplacer toutes les notes 14 par 15 dans le champ « Note » un tableau nommé « TS_Eleves » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_Remplacer(Tableau, "Note", 14, 15, True)
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_Remplacer(TS As Range, _
ByVal Colonne As Variant, _
ValeurCherchée As Variant, _
ValeurRemplacement As Variant, _
RespecterCasse As Boolean, _
Optional Correspondance As XlLookAt = xlWhole) As Boolean
'-----------------------------------------------------------------------------------------------
' Remplace une valeur dans une colonne d'un Tableau Structuré.
' Si le tableau est sur la feuille active les cellules masquées ne sont pas traitées.
' Si le tableau n'est pas sur la feuille active les cellules masquées sont traitées.
' La recherche/remplacement respecte la casse si RespecterCasse = True.
'-----------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' ValeurCherchée : La valeur à remplacer.
' ValeurRemplacement : La valeur de remplacement.
' RespecterCasse As Boolean : True pour respecter la casse ou False pour l'ignorer.
' Correspondance : Indique le mode de recherche :
'                  xlPart : Détecte une correspondance avec une partie du texte recherché.
'                  xlWhole : Détecte une correspondance avec l'ensemble du texte recherché.
'-----------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé, ou FAUX en cas d'erreur.
'------------------------------------------------------------------------------------------------
' Remarque : voir la documentation sur "Replace" pour plus d'informations.
' https://learn.microsoft.com/fr-fr/office/vba/api/excel.range.replace
'------------------------------------------------------------------------------------------------
' Exemples pour remplacer la valeur 14 dans le champ "Note" par la valeur 15:
' Debug.Print TS_Remplacer(Range("TS_X"), "Note", 14, 15, True)
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Si au moins une ligne existe:
If TS.ListObject.ListRows.Count > 0 Then

' Lance le remplacement avec la méthode Replace:
TS.ListObject.ListColumns(Colonne).DataBodyRange.Replace _
What:=ValeurCherchée, _
Replacement:=ValeurRemplacement, _
LookAt:=Correspondance, SearchOrder:=xlByRows, MatchCase:=RespecterCasse, _
SearchFormat:=False, ReplaceFormat:=False

End If

' Renvoie VRAI:
TS_Remplacer = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_Remplacer", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_Remplacer"
End If
Err.Clear

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

V-D - TS_Sélectionner

La fonction TS_Sélectionner sélectionne une plage dans un tableau structuré.
La plage peut être une cellule, une ligne entière, une colonne entière ou l’ensemble des données du tableau structuré.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : (facultatif) le nom ou le numéro de la colonne concernée. Si ce numéro est zéro, alors la dernière colonne du tableau structuré est traitée. Si cet argument n’est pas renseigné ou est vide, alors la ligne renseignée sera entièrement sélectionnée ;

- Ligne : (facultatif) la ligne concernée. Si cette valeur est zéro, alors la dernière ligne du tableau structuré est traitée. Si elle est inférieure à zéro, alors la ligne des totaux est traitée. Si cet argument n’est pas renseigné ou est vide, alors la colonne renseignée sera entièrement sélectionnée (juste les cellules visibles).

Si la colonne et la ligne ne sont pas renseignées, alors la sélection porte sur toutes les données du tableau structuré (juste les cellules visibles).

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Plusieurs exemples pour faire des sélections du tableau structuré des élèves, respectivement :

- l’ensemble des données visibles du tableau structuré ;

- la colonne « Nom » (juste les cellules visibles) ;

- la cellule située sur la 5e ligne de la colonne « Nom » ;

- la cellule située sur la dernière ligne de la colonne « Nom » ;

- le total de la colonne « Nom » ;

- la 5e ligne ;

- la dernière ligne ;

- la ligne des totaux.

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_Sélectionner(Tableau)
Call TS_Sélectionner(Tableau, "Nom")
Call TS_Sélectionner(Tableau, "Nom", 5)
Call TS_Sélectionner(Tableau, "Nom", 0)
Call TS_Sélectionner(Tableau, "Nom", -1)
Call TS_Sélectionner(Tableau, "", 5)
Call TS_Sélectionner(Tableau, "", 0)
Call TS_Sélectionner(Tableau, "", -1)
End Sub
'------------------------------------------------------------------------------------------------

Remarque : une fois les cellules sélectionnées, le programmeur peut les parcourir pour les analyser, les modifier ou leur appliquer un format, comme dans ces exemples :

'------------------------------------------------------------------------------------------------
Dim C As Range
Call TS_Sélectionner(Tableau, "Nom", "") ' Sélectionne la colonne "Nom".
For Each C In Selection
Debug.Print C          ' Affiche les noms.
Next C
'------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------
Call TS_Sélectionner(Tableau, "Note", "") ' Sélectionne la colonne "Note".
Selection.NumberFormat = "#0"             ' Modifie le format numérique.
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_Sélectionner(TS As Range, _
Optional ByVal Colonne As Variant = "", _
Optional ByVal Ligne As Variant) As Boolean
'------------------------------------------------------------------------------------------------
' Sélectionne une plage dans un tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne
'           Si 0 alors prend la dernière colonne du Tableau Structuré.
'           Si non renseigné alors sélectionne la ligne entière renseignée.
' Ligne : la ligne concernée.
'         Si 0 alors prend la dernière ligne du Tableau Structuré.
'         Si <0 alors prend la ligne des totaux.
'         Si non renseigné alors sélectionne la colonne entière renseignée.
' Si Colonne et Ligne ne sont pas renseignée alors sélectionne toutes les données.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une sélection a été faite.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Si la colonne et la ligne ne sont pas renseignées alors sélectionne toutes les données:
If Colonne = "" And IsMissing(Ligne) = True Then
TS.ListObject.DataBodyRange.Select
TS_Sélectionner = True
GoTo Gest_Err
End If

' Si la ligne n'est pas renseignée:
If IsMissing(Ligne) = True Then Ligne = ""
If Ligne = "" Then
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
' Sélectionner toutes les données de la colonne:
TS.ListObject.ListColumns(Colonne).DataBodyRange.Select
TS_Sélectionner = True
' Quitte le traitement:
GoTo Gest_Err
End If

' Si la ligne est 0 alors prend la dernière ligne:
If Ligne = 0 Then Ligne = TS.ListObject.ListRows.Count

' Si colonne est vide alors sélectionne toute la ligne:
If Colonne = "" Then
' La ligne du tableau:
If Ligne > 0 And Ligne <= TS.ListObject.ListRows.Count Then
TS.ListObject.ListRows(Ligne).Range.Select
TS_Sélectionner = True
End If
' La ligne des totaux:
If Ligne < 0 Then
TS.ListObject.ShowTotals = True
TS.ListObject.TotalsRowRange.Select
TS_Sélectionner = True
End If
' Quitte le traitement:
GoTo Gest_Err
End If

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Deux cas de sélection possibles:
If Ligne < 0 Then ' Sélectionne juste le total.
TS.ListObject.ShowTotals = True
TS.ListObject.Range(TS.ListObject.ListRows.Count + 2, Colonne).Select
TS_Sélectionner = True
Else ' Sélectionne une cellule:
Ligne = TS_IndexLigne(TS, CLng(Ligne))
If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
TS.ListObject.Range(Ligne + 1, Colonne).Select
TS_Sélectionner = True
End If

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_Sélectionner", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_Sélectionner"
End If
Err.Clear

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

V-E - TS_Range

La fonction TS_Range renvoie une plage de données d'un tableau structuré. La plage peut être une cellule, une ligne, une colonne. La feuille du tableau structuré n'a pas besoin d'être active.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- VisibleUniquement : Si True seules les données visibles sont traitées, si False les données masquées sont prises en compte également ;

- Colonne : le numéro de la colonne, ou le nom de la colonne. Si 0 est renseigné alors prend la dernière colonne. Si la colonne n'est pas renseignée alors traite la ligne entière renseignée ;

- Ligne : la ligne concernée. Si 0 est renseigné alors prend la dernière ligne. Si inférieur à 0 alors prend la ligne des totaux. Si la ligne est non renseignée alors traite la colonne entière renseignée.

Si la colonne et la ligne ne sont pas renseignées, alors sélectionne toutes les données du tableau structuré.

La fonction renvoie : un Range de la sélection faite ou Nothing.

Plusieurs exemples pour renvoyer un Range du tableau structuré des élèves, respectivement :

- pour renvoyer les données de la colonne « Nom » (sans l'en-tête et le total) ;

- pour renvoyer la cellule située 5e ligne de la colonne « Nom » ;

- pour renvoyer la dernière ligne de la colonne « Nom » ;

- pour renvoyer la cellule située sur la dernière ligne de la colonne « Nom » ;

- pour renvoyer le total de la colonne « Nom » ;

- pour renvoyer la 5e ligne ;

- pour renvoyer la dernière ligne ;

- pour renvoyer la ligne des totaux ;

- pour ne renvoyer que les données visibles du Tableau Structuré.

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim r as Range
Set r = TS_Range(TS, False, "Nom") ' pour renvoyer les données de la colonne "Nom" (sans l'en-tête et le total).
Set r = TS_Range(TS, False, "Nom", 5) ' pour renvoyer la cellule située 5ème ligne de la colonne "Nom"
Set r = TS_Range(TS, False, "Nom", 0) ' pour renvoyer la dernière ligne de la colonne "Nom".
Set r = TS_Range(TS, False, "Nom", -1) ' pour renvoyer le total de la colonne "Nom".
Set r = TS_Range(TS, False, , 5) ' pour renvoyer la 5ème ligne.
Set r = TS_Range(TS, False, , 0) ' pour renvoyer la dernière ligne.
Set r = TS_Range(TS, False, , -1) ' pour renvoyer la ligne des totaux.
Set r = TS_Range(TS, True) ' pour ne renvoyer que les données visibles du Tableau Structuré.

' Vous pouvez utilise r comme une plage ordinaire, exemples:
' r.Count/r.Columns.Count = nombre le lignes, r.Columns.Count = nombre de colonnes,
' r.Cells(1, 1).Value = valeur cellule.
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_Range(TS As Range, _
VisibleUniquement As Boolean, _
Optional ByVal Colonne As Variant = "", _
Optional ByVal Ligne As Variant) As Range
'------------------------------------------------------------------------------------------------
' Renvoie une plage de données d'un tableau Structuré.
' La plage peut être une cellule, une ligne, une colonne.
' Remarque : La feuille du tableau structuré n'a pas besoin d'être active.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' VisibleUniquement : Si VRAI ne traite que les lignes visibles.
' Colonne : Le numéro de la colonne, ou le nom de la colonne
'           Si 0 alors prend la dernière colonne du Tableau Structuré.
'           Si non renseigné alors traite la ligne entière renseignée.
' Ligne : La ligne concernée.
'         Si 0 alors prend la dernière ligne du Tableau Structuré.
'         Si <0 alors prend la ligne des totaux.
'         Si non renseigné alors traite la colonne entière renseignée.
' Si Colonne et Ligne ne sont pas renseignée alors sélectionne toutes les données.
'------------------------------------------------------------------------------------------------
' Renvoie : Un range de la sélection faite ou Nothing.
'------------------------------------------------------------------------------------------------
Dim R As Range

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

' Si la colonne et la ligne ne sont pas renseignées alors renvoie toutes les données:
If Colonne = "" And IsMissing(Ligne) = True Then
Set R = TS.ListObject.DataBodyRange
GoTo Gest_Err
End If

' Si la ligne n'est pas renseignée:
If IsMissing(Ligne) = True Then Ligne = ""
If Ligne = "" Then
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
' Renvoie toutes les données de la colonne:
Set R = TS.ListObject.ListColumns(Colonne).DataBodyRange
' Quitte le traitement:
GoTo Gest_Err
End If

' Si la ligne est 0 alors prend la dernière ligne:
If Ligne = 0 Then Ligne = TS.ListObject.ListRows.Count

' Si colonne est vide alors renvoie toute la ligne:
If Colonne = "" Then
' La ligne du tableau:
If Ligne > 0 And Ligne <= TS.ListObject.ListRows.Count Then
Set R = TS.ListObject.ListRows(Ligne).Range
End If
' La ligne des totaux:
If Ligne < 0 Then
TS.ListObject.ShowTotals = True
Set R = TS.ListObject.TotalsRowRange
End If
' Quitte le traitement:
GoTo Gest_Err
End If

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Deux cas de renvois possibles:
If Ligne < 0 Then ' Renvoie juste le total.
TS.ListObject.ShowTotals = True
Set R = TS.ListObject.Range(TS.ListObject.ListRows.Count + 2, Colonne)
Else ' Renvoie une cellule:
Ligne = TS_IndexLigne(TS, CLng(Ligne))
If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
Set R = TS.ListObject.Range(Ligne + 1, Colonne)
End If

' Fin du traitement:
Gest_Err:

' S'il faut ou non ne prendre que les cellules visibles:
If Not R Is Nothing Then
On Error Resume Next
If VisibleUniquement = True Then
Set TS_Range = R.SpecialCells(xlCellTypeVisible)
Else
Set TS_Range = R
End If
On Error GoTo 0
End If

TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_Range", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_Range"
End If
Err.Clear

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

V-F - TS_ModifCellule

La fonction TS_ModifCellule modifie les informations sur une cellule d’un tableau structuré, même si elle est masquée.
La cellule concernée est identifiée par sa position dans le tableau structuré. La première colonne vaut 1 (il est conseillé d’utiliser le nom de la colonne au lieu de son numéro), la première ligne vaut 1.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou zéro, alors la dernière colonne du tableau est traitée ;

- Ligne : la ligne concernée. Si cette valeur est zéro, alors prend la dernière ligne du tableau structuré. Si elle est inférieure à zéro, alors prend la ligne des totaux ;

- Valeur : la valeur de référence qui sera utilisée pour modifier la cellule ;

- TypeInfo : (facultatif) le type d’information désiré défini par une valeur de l’énumération personnelle Enum_InfoTS déclarée en en-tête du module
- TS_Valeur : (par défaut) modifie la valeur de la cellule,
- TS_Ajouter : ajoute à la valeur existante la valeur passée dans Valeur,
- TS_Soustraire : soustrait à la valeur existante la valeur passée dans Valeur,
- TS_Multiplier : multiplie la valeur existante par la valeur passée dans Valeur,
- TS_Diviser : divise la valeur existante par la valeur passée dans Valeur,
- TS_Formule : applique à la cellule la formule passée dans Valeur,
- TS_CouleurTexte : applique à la cellule la couleur de texte passée dans Valeur,
- TS_CouleurFond : applique à la cellule la couleur de fond passée dans Valeur (si Valeur est vide alors efface la couleur de fond),
- TS_Gras : met la cellule en gras ou non selon que Valeur vaut True ou False,
- TS_Italique : met la cellule en italique ou non selon que Valeur vaut True ou False,
- TS_Format : applique à la cellule le format passé dans Valeur,
- TS_Commentaire : applique à la cellule le commentaire passé dans Valeur ou l’efface si Valeur est vide,
- TS_ImageCommentaireJPG : applique au commentaire l'image "jpg" passée dans Valeur ou l’efface si Valeur est vide,
- TS_LienHypertexte : applique à la cellule le lien hypertexte passé dans Valeur ou l’efface si Valeur est vide ;

- LargeurCommentaire : (facultatif) la largeur du commentaire (ou 0 pour la taille par défaut) ;

- HauteurCommentaire: (facultatif) la hauteur du commentaire (ou 0 pour la taille par défaut).

- Mémoire : (facultatif) la mémoire qui représente une image du tableau et où sont faites les modifications. Cela permet d'être plus rapide sur les traitements en boucle qui appellent de nombreuses fois TS_ModifCellule (même avec écran et calculs bloqués). Utilisez TypeInfo = TS_ViderMémoire pour actualiser le tableau avec cette image. Une fois vidée, la mémoire peut être réutilisée pour servir d'image à un tableau.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Plusieurs exemples pour modifier la dernière ligne de la colonne « Note » du tableau structuré des élèves, respectivement :

- pour passer la note à 15 ;

- pour ajouter 2 à la note existante ;

- pour la mettre en gras ;

- pour la mettre en rouge ;

- pour y ajouter un commentaire qui sera affiché dans une infobulle de 120 sur 20.

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_ModifCellule(Tableau, "Note", 0, 15)
Call TS_ModifCellule(Tableau, "Note", 0, 2, TS_Ajouter)
Call TS_ModifCellule(Tableau, "Note", 0, True, TS_Gras)
Call TS_ModifCellule(Tableau, "Note", 0, 255, TS_CouleurTexte)
Call TS_ModifCellule(Tableau, "Note", 0, "De gros efforts réalisés.", TS_Commentaire, 120, 20)
End Sub
'------------------------------------------------------------------------------------------------

Remarque : cette fonction permet aussi de modifier les formules de la ligne des totaux (pour y mettre des formules personnalisées) par exemple pour avoir la moyenne des notes y compris quand des lignes sont masquées :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_ModifCellule(Tableau, "Note", -1, "=SUM(TS_Eleves[Note])/COUNT(TS_Eleves[Note])", TS_Formule)
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ModifCellule(TS As Range, _
ByVal Colonne As Variant, _
ByVal Ligne As Long, _
Valeur As Variant, _
Optional TypeInfo As Enum_InfoTS = TS_Valeur, _
Optional LargeurCommentaire As Long = 0, _
Optional HauteurCommentaire As Long = 0, _
Optional ByRef Mémoire As Variant) As Boolean
'------------------------------------------------------------------------------------------------
' Modifie une information sur la cellule même si elle est masquée.
' L'information peut être la valeur ou la formule ou la couleur du texte...
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Ligne : la ligne concernée.
'         Si 0 alors prend la dernière ligne du Tableau Structuré.
'         Si <0 alors prend la ligne des totaux.
' Valeur : la valeur à appliquer.
' TypeInfo : Type d'information à modifier, voir l'énumération Enum_InfoTS
'            TS_Valeur : Modifie la valeur qui prend la valeur passée dans Valeur.
'            TS_Ajouter : Ajoute à la valeur existante la valeur passée dans Valeur.
'            TS_Soustraire : Soustrait à la valeur existante la valeur passée dans Valeur.
'            TS_Multiplier : Multiplie la valeur existante par la valeur passée dans Valeur.
'            TS_Diviser : Divise la valeur existante par la valeur passée dans Valeur.
'            TS_Formule : Modifie la formule qui devient la formule passée dans Valeur.
'            TS_CouleurTexte : Modifie la couleur de texte qui prend la valeur passée dans Valeur.
'            TS_CouleurFond : Modifie la couleur de fond qui prend la valeur passée dans Valeur.
'                             Si valeur est vide alors efface la couleur de fond.
'            TS_Gras : Si Valeur vaut Vrai alors met la cellule est en gras.
'            TS_Italique : Si Valeur vaut Vrai alors met la cellule est en italique.
'            TS_Format : Modifie le format de la cellule.
'            TS_Commentaire : Modifie le commentaire (vide pour l'effacer).
'            TS_ImageCommentaireJPG : Modifie l'image "jpg" d'un commentaire (vide pour l'effacer).
'            TS_LienHypertexte : Modifie le lien Hypertexte de la cellule (vide pour l'effacer).
' LargeurCommentaire : Largeur du commentaire, ou 0 pour la taille par défaut.
' HauteurCommentaire : Hauteur du commentaire, ou 0 pour la taille par défaut.
' Mémoire : La mémoire qui représente une image du tableau et où sont faites les modifications.
'           Cela permet d'être plus rapide sur les traitements en boucle qui appellent
'           de nombreuses fois TS_ModifCellule (même avec écran et calculs bloqués).
'           Utilisez TypeInfo = TS_ViderMémoire pour actualiser le tableau avec cette image.
'           Une fois vidée, la mémoire peut être réutilisée pour servir d'image à un tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear

' Si le tableau est vierge alors il faut l'initialiser:
If TS.ListObject.ListRows.Count = 0 And (Ligne = 0 Or Ligne = 1) Then
Call TS_AjouterUneLigne(TS, 0)
End If

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Deux cas de modification possibles:
If Ligne < 0 Then ' Ligne des totaux:
Ligne = TS.ListObject.ListRows.Count + 1
TS.ListObject.ShowTotals = True
Else ' Ligne du taleau:
Ligne = TS_IndexLigne(TS, Ligne)
If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
End If

' Utilise une mémoire cache si l'argument est renseigné:
If IsMissing(Mémoire) = False Then
' Initialise une image du tableau si l'argument passé est vide:
If IsEmpty(Mémoire) = True Then Mémoire = TS.ListObject.DataBodyRange.Formula
' Suivant le type d'action demandé:
Select Case TypeInfo
Case TS_Valeur
Mémoire(Ligne, Colonne) = Valeur: GoTo Gest_Err
Case TS_Ajouter
If IsNumeric(Mémoire(Ligne, Colonne)) = False Then _
Mémoire(Ligne, Colonne) = Val(Mémoire(Ligne, Colonne))
Mémoire(Ligne, Colonne) = Mémoire(Ligne, Colonne) + Valeur: GoTo Gest_Err
Case TS_Soustraire
If IsNumeric(Mémoire(Ligne, Colonne)) = False Then _
Mémoire(Ligne, Colonne) = Val(Mémoire(Ligne, Colonne))
Mémoire(Ligne, Colonne) = Mémoire(Ligne, Colonne) - Valeur: GoTo Gest_Err
Case TS_Multiplier
If IsNumeric(Mémoire(Ligne, Colonne)) = False Then _
Mémoire(Ligne, Colonne) = Val(Mémoire(Ligne, Colonne))
Mémoire(Ligne, Colonne) = Mémoire(Ligne, Colonne) * Valeur: GoTo Gest_Err
Case TS_Diviser
If IsNumeric(Mémoire(Ligne, Colonne)) = False Then _
Mémoire(Ligne, Colonne) = Val(Mémoire(Ligne, Colonne))
Mémoire(Ligne, Colonne) = Mémoire(Ligne, Colonne) / Valeur: GoTo Gest_Err
Case TS_Formule
Mémoire(Ligne, Colonne) = Valeur: GoTo Gest_Err
Case TS_ViderMémoire
Dim Filtres As Variant
Call TS_Filtres_Mémoriser(TS, Filtres)        ' Mémorise les filtres.
Call TS_Filtres_Effacer(TS)                   ' Les effaces.
TS.ListObject.DataBodyRange.Formula = Mémoire ' Transfert la mémoire cache dans le tableau.
Call TS_Filtres_Restaurer(TS, Filtres)        ' Remet les filtres.
Mémoire = Empty                               ' Vide la mémoire.
End Select
End If

' Modifie la cellule suivant le type demandé:
With TS.ListObject.DataBodyRange(Ligne, Colonne)
Select Case TypeInfo
Case TS_Valeur
.Value = Valeur
Case TS_Ajouter
.Value = .Value + Valeur
Case TS_Soustraire
.Value = .Value - Valeur
Case TS_Multiplier
.Value = .Value * Valeur
Case TS_Diviser
.Value = .Value / Valeur
Case TS_Formule
.Formula = Valeur
Case TS_CouleurTexte
.Font.Color = Valeur
Case TS_CouleurFond
If IsNumeric(Valeur) = True Then .Interior.Color = Valeur
If Valeur = "" Then .Interior.Pattern = xlNone
Case TS_Gras
If Valeur = True Then .Font.Bold = True
If Valeur = False Then .Font.Bold = False
Case TS_Italique
If Valeur = True Then .Font.Italic = True
If Valeur = False Then .Font.Italic = False
Case TS_Format
.NumberFormat = Valeur
Case TS_Commentaire
.ClearComments
If Valeur <> "" Then
.AddComment
.Comment.Text Text:=Valeur
If HauteurCommentaire > 0 Then .Comment.Shape.Height = HauteurCommentaire
If LargeurCommentaire > 0 Then .Comment.Shape.Width = LargeurCommentaire
End If
Case TS_ImageCommentaireJPG
.ClearComments
If Valeur <> "" Then
.AddComment
.Comment.Shape.Fill.UserPicture Valeur
If HauteurCommentaire > 0 Then .Comment.Shape.Height = HauteurCommentaire
If LargeurCommentaire > 0 Then .Comment.Shape.Width = LargeurCommentaire
End If
Case TS_LienHypertexte
.Hyperlinks.Delete
If Valeur <> "" Then
.Hyperlinks.Add Anchor:=TS.ListObject.DataBodyRange(Ligne, Colonne), Address:=Valeur
End If
End Select
End With

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number = 0 Then TS_ModifCellule = True
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ModifCellule", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ModifCellule"
End If
Err.Clear

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

Pour accélérer les traitements de mise à jour des données il est conseillé d'utiliser Application.ScreenUpdating = False pour éviter la mise à jour de l'écran et Application.Calculation = xlCalculationManual pour bloquer les calculs.
Puis vous restaurez la situation avec Application.Calculation = xlCalculationAutomatic et Application.ScreenUpdating = True.

Il y a encore plus rapide, en utilisant une mémoire cache qui représente les données du tableau structuré.
Les données sont mises à jour dans cette mémoire et à la fin du traitement le tableau est alimenté par cette mémoire.
Les traitements sont alors environ cinq fois plus rapides qu'avec l'écran et les calculs bloqués, ce qui n'est pas négligeable, et les propriétés Application.Calculation et Application.ScreenUpdating n'ont même pas besoin d'être utilisées.

La fonction TS_ModifCellule gère cela en passant dans son argument Mémoire une variable préalablement déclarée de type Variant.
Utilisez la fonction TS_ModifCellule dans vos traitements comme d'habitude sans oublier de renseigner l'argument Mémoire.

Pour basculer la mémoire dans le tableau structuré faites un nouvel appel à la fonction TS_ModifCellule en utilisant TS_ViderMémoire comme valeur de l'argument TypeInfo.
Cette appel vide la mémoire qui peut être réutilisée pour servir d'image cache à un autre tableau.
Les arguments obligatoires Colonne, Ligne et Valeur n'ont pas d'utilité et peuvent être laissés à zéro.

Dim M As Variant, i As Integer
For i=1 to 1000: Call TS_ModifCellule(Range("Tableau1"), 1, 1, 10, TS_Ajouter, , , M): Next i
Call TS_ModifCellule(Range("Tableau1"), 0, 0, "", TS_ViderMémoire, , , M)

V-G - TS_ForcerValeurColonne

La fonction TS_ForcerValeurColonne met une valeur unique dans une colonne d'un tableau structuré.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée ;

- Valeur : la valeur qu'il faut utiliser ;

- VisibleUniquement : si True alors ne traite que les lignes visibles, si False alors traite toutes les lignes même les masquées.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour mettre la valeur "Ok" dans la colonne "Admis" pour les élèves dont la note est supérieure ou égale à 10 :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves_1")

' Filtre les notes >= 10:
Call TS_Filtres_Poser(Tableau, "Note", ">=10")

' Force la valeur OK dans la colonne "Admis" pour les lignes visibles:
Call TS_ForcerValeurColonne(TS:=Tableau, Colonne:="Admis", Valeur:="OK", VisibleUniquement:=True)

' Efface le filtre:
Call TS_Filtres_Effacer(Tableau)

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

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ForcerValeurColonne(TS As Range, ByVal Colonne As Variant, Valeur As Variant, VisibleUniquement As Boolean) As Boolean
'------------------------------------------------------------------------------------------------------
' Met une valeur unique dans une colonne d'un tableau structuré.
' TS : le tableau structuré concerné.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Valeur : la valeur à utiliser.
' VisibleUniquement : Si VRAI ne traite que les lignes visibles.
'------------------------------------------------------------------------------------------------------
Dim AncCalculation
Dim AncScreenUpdating As Boolean

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

' Bloque les calculs:
AncCalculation = Application.Calculation
Application.Calculation = xlCalculationManual
AncScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Si la colonne n'est pas filtrée:
If TS_Filtres_Existe(TS) = False Then

' On peut utiliser cette méthode qui est rapide:
TS.ListObject.ListColumns(Colonne).DataBodyRange = Valeur
' Renvoie VRAI:
TS_ForcerValeurColonne = True

' Sinon il faut traiter les cellules une à une car ListColumns réagit
' différemment sur les cellules visibles ou non suivant que la feuille
' est active ou non:
Else

' Mémorise le tableau:
Dim Mémoire As Variant, i As Long
Mémoire = TS.ListObject.DataBodyRange.Formula
' Boucle sur les lignes visibles ou toutes si VisibleUniquement = False
For i = 1 To TS_Nombre_Lignes(TS)
If TS.ListObject.DataBodyRange(i, 1).Height > 0 Or VisibleUniquement = False Then
Mémoire(i, Colonne) = Valeur
End If
Next i
' Mise à jour du tableau d'après la mémoire (les filtres doivent être retirés):
Dim Filtres As Variant
Call TS_Filtres_Mémoriser(TS, Filtres)
Call TS_Filtres_Effacer(TS)
TS.ListObject.DataBodyRange.Formula = Mémoire
Call TS_Filtres_Restaurer(TS, Filtres)

End If

' Fin du traitement:
Gest_Err:
' Restaure les calculs:
Application.Calculation = AncCalculation
Application.ScreenUpdating = AncScreenUpdating
' Erreurs:
If Err.Number = 1004 Then Err.Clear
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ForcerValeurColonne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ForcerValeurColonne"
End If
Err.Clear

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

VI - Importer, exporter des données d’un tableau structuré

Ce chapitre est consacré à l’importation et l’exportation des données.

VI-A - TS_ImporterDonnées (version importation)

La fonction TS_ImporterDonnées permet d’importer des données depuis un autre tableau structuré en sélectionnant les critères d’importation.
Toutes les colonnes du tableau de destination qui ont une correspondance dans le tableau qui contient les données à importer sont traitées, les autres colonnes sont ignorées.

ATTENTION : Les lignes masquées du tableau structuré qui contient les données à importer ne sont pas importées. Ce qui permet (éventuellement) de faire en amont une règle de gestion des importations.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré où seront importées les données (c’est-à-dire le tableau destination) ;

- TD : la plage (de type Range) qui représente le tableau structuré source d’où proviennent les données ;

- Méthode : la méthode d’importation désirée définie par une valeur de l’énumération personnelle Enum_ImportationTS déclarée en en-tête du module
- TS_Ajout_Forcé : ajoute les lignes au tableau d'origine même si elles existent déjà (dans ce cas laissez ListeColonnesClés à vide),
- TS_MAJ_Uniquement : ne fait que des mises à jour et refuse les ajouts,
- TS_MAJ_Ou_Ajout : fait une mise à jour si possible ou un ajout si la donnée est nouvelle,
- TS_IgnorerSiExiste : ne tient pas compte de la donnée si elle existe déjà ;

- RespecterCasse : True pour respecter la casse ou False pour l’ignorer ;

- ListeColonnesClés : la liste des colonnes (en-tête) qui servent de clés de référence dans la comparaison des mises à jour, de type ParamArray (tableau de paramètres), séparées par une virgule.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Remarque : l’importation nécessite que les deux tableaux aient en commun les champs utilisés pour la clé.

Exemple d’importation de données pour mettre à jour les notes des élèves du tableau structuré d’origine « TS_Eleves » (tableau de gauche) et y ajouter les nouveaux élèves, avec les données du tableau structuré « Données » (tableau de droite) :

Les clés seront « Nom » et « Prénom », champs présents dans les deux tableaux (l’ordre n’a pas d’importance).
La colonne « Note », présente dans les deux tableaux sera traitée et mettra à jour le tableau d’origine, inversement, la colonne « Date » sera ignorée puisque qu’elle n’a pas de correspondance dans le tableau d’origine (une importation serait possible si l’on ajoutait ce champ au tableau d’origine, il n’y a pas de limite dans le nombre de colonnes qui peuvent être mises à jour).
La méthode d’importation sera « TS_MAJ_Ou_Ajout » pour mettre à jour la note des élèves existants et ajouter les nouveaux élèves.
La casse sera ignorée car les données à importer ont parfois un format différent.
Les éventuels filtres du tableau structuré « Données » seront effacés pour importer toutes les données.
En cas d’erreur de traitement, un message le signale :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Dim TD As Range
Set TD = Range("Données")

' Efface les éventuels filtres sur le tableau des données à importer :
Call TS_Filtres_Effacer(TD)

' Importe les données suivant les clés Nom et Prénom, renvoie False en cas d’erreur et l’affiche :
If TS_ImporterDonnées(Tableau, TD, TS_MAJ_Ou_Ajout, False, "Nom", "prénom") = False Then
MsgBox TS_Err_Number & " : " & TS_Err_Description, vbCritical, "Erreur de traitement"
End If

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

Ce qui donne :

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ImporterDonnées(TS As Range, _
TD As Range, _
Méthode As Enum_ImportationTS, _
RespecterCasse As Boolean, _
ParamArray ListeColonnesClés() As Variant) As Boolean
'------------------------------------------------------------------------------------------------
' Permet l'importation de données depuis un Tableau Structuré pour alimenter
' le Tableau Structuré d'origine.
' Toutes les colonnes du tableau d'origine qui ont une correspondance dans le tableau qui contient
' les données à importer sont traitées.
'------------------------------------------------------------------------------------------------
' ATTENTION : les lignes masquées du Tableau Structuré qui contient les données à importer
' ~~~~~~~~~~  ne sont pas importées. Ce qui permet (éventuellement) de faire en amont une règle
'             de gestion des importations.
'------------------------------------------------------------------------------------------------
' TS : le Tableau Structuré d'origine.
' TD : le Tableau Structuré qui contient les données à importer.
' Méthode : la méthode d'importation
'           TS_Ajout_Forcé : Ajoute les lignes au tableau d'origine même si elles existent déjà, dans
'                            ce cas mettre "" pour ListeColonnesClés.
'           TS_MAJ_Uniquement : Ne fait que des mises à jour et refuse les ajouts.
'           TS_MAJ_Ou_Ajout : Fait une mise à jour si possible ou un ajout si la donnée est nouvelle.
'           TS_IgnorerSiExiste : Ne tient pas compte de la donnée si elle existe déjà.
' RespecterCasse As Boolean : True pour respecter la casse ou False pour l'ignorer.
' ListeColonnesClés : la liste des colonnes (en-tête) qui sert de clé de référence dans la comparaison
'                     des mises à jour, de type ParamArray (tableau de paramètres).
'                     Passez en argument soit le nom soit le numéro de la colonne.
'                     Un ParamArray est limité à 32 arguments, séparés par une virgule.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim x As Integer, i As Integer, y As Long, yy As Long, NomColonne As String
Dim Ajout As Boolean
Dim Arguments() As Variant
Dim NbClé As Integer
Dim MesFiltres As Variant

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

' Mémorise les éventuels filtres et les retire:
Call TS_Filtres_Mémoriser(TS, MesFiltres)
Call TS_Filtres_Effacer(TS)

' S'il y a des colonnes renseignées pour former une clé:
If IsMissing(ListeColonnesClés) = False Then
NbClé = (UBound(ListeColonnesClés) + 1) * 2
ReDim Arguments(1 To NbClé)
x = 1
For i = 0 To UBound(ListeColonnesClés)
Arguments(x) = ListeColonnesClés(i)
If IsNumeric(Arguments(x)) = True Then _
Arguments(x) = TS.ListObject.ListColumns(Arguments(x)).Name
x = x + 2
Next i
End If

' Boucle sur les lignes du Tableau Structuré à importer :
For y = 1 To TD.ListObject.ListRows.Count

Ajout = False
yy = 0

' Si la ligne est masquée alors passer à la suivante:
If TD.ListObject.DataBodyRange(y, 1).Height = 0 Then GoTo Suite_Y

' Si une recherche sur les titres:
If NbClé > 0 And Méthode <> TS_Ajout_Forcé Then

For i = 2 To NbClé Step 2
' Renvoie la valeur de la colonne clé:
Arguments(i) = TS_InfoCellule(TD, Arguments(i - 1), y, TS_valeur)
' Si la clé n'existe pas:
If TS_Err_Number <> 0 Then Err.Raise TS_Err_Number, , TS_Err_Description
Next i

' Si la clé est trouvée dans le tableau destination alors ne pas
' ajouter une ligne mais travailler sur la ligne trouvée = yy.
' La recherche tient compte de la casse ou non:
yy = TS_Rechercher(TS, RespecterCasse, Arguments)
If yy <> 0 Then Ajout = True
If TS_Err_Number <> 0 Then Err.Raise TS_Err_Number, , TS_Err_Description

' Si l'on ne doit faire que des mises à jour alors passer à la suite
' si la donnée n'est pas trouvée dans le tableau destination:
If Méthode = TS_MAJ_Uniquement And yy = 0 Then GoTo Suite_Y

' Si l'on doit ignorer les données qui existe déjà alors passer
' à la suite si la donnée est trouvée dans le tableau destination:
If Méthode = TS_IgnorerSiExiste And yy <> 0 Then GoTo Suite_Y

End If

' Boucle sur les colonnes:
For x = 1 To TD.ListObject.ListColumns.Count
' Récupère le nom de la colonne:
NomColonne = TD.ListObject.HeaderRowRange(x).Value
' Vérifie si elle exite dans le tableau destination:
If TS_IndexColonne(TS, NomColonne) > -1 Then
' S'il faut ajouter une ligne:
If Ajout = False Then
Ajout = True
TS.ListObject.ListRows.Add
yy = 0
End If
' Ajoute la donnée au tableau destination:
Call TS_ModifCellule(TS, NomColonne, yy, TD.ListObject.DataBodyRange(y, x).Value, TS_Valeur)
End If
Next x

Suite_Y:
Next y

' Restaure les filtres et l'affichage:
Call TS_Filtres_Restaurer(TS, MesFiltres)

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number = 0 Then TS_ImporterDonnées = True
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ImporterDonnées", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ImporterDonnées"
End If
Err.Clear

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

VI-B - TS_ImporterDonnées (version exportation)

La fonction TS_ImporterDonnées permet aussi d’exporter des données vers un autre tableau structuré.

Puisque ce qui est une importation pour l’un est une exportation pour l’autre.

ATTENTION : Les lignes masquées du tableau structuré qui contient les données à exporter ne sont pas exportées. Ce qui permet (éventuellement) de faire en amont une règle de gestion des importations.

Exemple d’exportation des données du tableau des élèves pour avoir une liste sans doublon des noms dans un nouveau tableau structuré sur la feuille « Feuil2 » qui sera nommé « Tableau_Noms » :

La clé sera le « Nom ».
La méthode sera « TS_MAJ_Ou_Ajout » pour éviter justement les doublons.
Un tableau structuré sera généré pour recevoir les données qui seront classées par ordre croissant :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Dim TS_Destination As Range

' Suppression de l'éventuel ancien tableau (erreur générée si Range("Tableau_Noms") n’existe pas):
On Error Resume Next
Set TS_Destination = Range("Tableau_Noms")
Call TS_SupprimerLeTableau(TS_Destination)

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

' Création du tableau sans doublon:
Set TS_Destination = TS_CréerUnTableau(Plage:=ThisWorkbook.Sheets("Feuil2").Range("A1"), _
Titres:="Nom", _
Nom:="Tableau_Noms", _
Style:="*")

' Importation des données sans doublons:
Call TS_ImporterDonnées(TS_Destination, Tableau, TS_MAJ_Ou_Ajout, True, "Nom")

' Tri de la colonne:
Call TS_TrierUneColonne(TS:=TS_Destination, _
Colonne:="Nom", _
Méthode:=xlSortOnValues, _
Ordre:=xlAscending, _
EffacerAncienTri:=True)

' Gestion des erreurs:
Gest_Err:
If Err.Number <> 0 Then MsgBox Err.Number & " : " & Err.Description, vbCritical, Err.Source

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

Ce qui donne :

VI-C - TS_ExporterEnFichier

La fonction TS_ExporterEnFichier exporte un tableau structuré du classeur actif en fichier image JPG ou BMP, en fichier au format « Portable Document Format » PDF, en fichier texte au format CSV, ou en fichier Excel.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- FormatFichier : le format de fichier à générer suivant l’énumération Enum_ExportationTS
- TS_XLSX : fichier Excel,
- TS_CSV : fichier texte au format CSV avec le séparateur point-virgule (les lignes masquées ne sont pas reprises),
- TS_BMP : fichier image au format BMP,
- TS_JPG : fichier image au format JPG,
- TS_PDF : fichier au format PDF ;

- OuvrirFichier : si True alors ouvre le fichier généré.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour exporter le tableau structuré nommé « TS_Eleves » en fichier PDF et l’ouvrir :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
If TS_ExporterEnFichier(Range("TS_Eleves"), TS_PDF, "P:\Fichier\Tableau_Eleves.pdf", True) = False Then
MsgBox TS_Err_Number & " : " & TS_Err_Description, vbCritical, "Erreur de conversion en PDF"
End If
'------------------------------------------------------------------------------------------------

Vous trouverez en annexe 2 un code VBA pour fusionner deux fichiers PDF si vous disposez de l’application « Adobe Acrobat Pro ».

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ExporterEnFichier(TS As Range, _
FormatFichier As Enum_ExportationTS, _
ByVal FichierDest As String, _
OuvrirFichier As Boolean) As Boolean
'------------------------------------------------------------------------------------------------
' Exporte un Tableau Structuré du classeur actif en fichier au format XLSX, CSV, BMP, JPG, PDF.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' FormatFichier : le format de fichier à générer, voir l'énumération Enum_ExportationTS
'               TS_XLSX : fichier Excel.
'               TS_CSV : fichier texte au format CSV, séparateur point-virgule (ne prend pas les lignes masquées).
'               TS_BMP : fichier image au format BMP.
'               TS_JPG : fichier image au format JPG.
'               TS_PDF : fichier au format "Portable Document Format" PDF.
' FichierDest : le chemin destination (qui doit exister) et le nom du fichier à créer,
'               si un fichier existait déjà il est remplacé.
' OuvrirFichier : Si VRAI alors ouvre le fichier généré.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim Repertoire As String, Sh As Worksheet
Dim Filtre As String
Dim Tmp As String, FileNumber As Long, ol As Range, oC As Range
Dim Anc_ScreenUpdating As Boolean
Dim Anc_Visible As Integer
Dim ObjPicture As Object
Dim Rng As Range

On Error GoTo Gest_Err
Err.Clear

' Mémorise la feuille active:
Set Sh = ActiveSheet

' Force la mise à jour de l'écran:
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = True

' Sélection de la feuille et de la plage:
Anc_Visible = Sheets(TS.Parent.Name).Visible
Sheets(TS.Parent.Name).Visible = True
Sheets(TS.Parent.Name).Activate
Set Rng = TS.ListObject.Range

' Le fichier destination doit être renseigné:
If FichierDest = "" Then Err.Raise vbObjectError, , "Le fichier destination doit être renseigné."

' Le répertoire doit exister:
Repertoire = Left(FichierDest, InStrRev(FichierDest, "\"))
If CreateObject("Scripting.FileSystemObject").Folderexists(Repertoire) = False Then _
Err.Raise vbObjectError, , "Le dossier de destination " & Repertoire & " n'est pas présent."

' Traitements suivant le type de fichier à générer:
Application.Cursor = xlWait
Select Case FormatFichier

Case TS_CSV

' Contrôle la présence de l'extension et supprime le fichier existant:
If UCase(Right(FichierDest, 4)) <> ".CSV" Then FichierDest = FichierDest & ".csv"
If Dir(FichierDest) <> "" Then Kill FichierDest

' Ajustement des colonnes pour ne pas avoir de # quand elles sont trop petites:
TS.Cells.EntireColumn.AutoFit

' Création d'un fichier:
FileNumber = FreeFile
Open FichierDest For Output As #FileNumber

' Boucle sur les lignes:
For Each ol In Rng.Rows
' Boucle sur les cellules de la ligne:
Tmp = ""
' Si la ligne n'est pas masquée:
If ol.Height <> 0 Then
' Boucle sur les colonnes:
For Each oC In ol.Cells
Tmp = Tmp & CStr(oC.Text) & ";"
Next
' Ne pas prendre le dernier séparateur:
Tmp = Left(Tmp, Len(Tmp) - 1)
' Ecriture dans le fichier:
Print #FileNumber, Tmp
End If
Next
Close #FileNumber

Case TS_XLSX

' Contrôle la présence de l'extension et supprime le fichier existant:
If UCase(Right(FichierDest, 5)) <> ".XLSX" Then FichierDest = FichierDest & ".xlsx"
If Dir(FichierDest) <> "" Then Kill FichierDest

' Copie le Tableau Structuré:
TS.ListObject.Range.Copy

' Ouvre une instance Excel et un classeur:
Dim AppXl As Excel.Application
Set AppXl = CreateObject("excel.application")
AppXl.Visible = False
AppXl.Workbooks.Add

' Y copie le Tableau Structuré en plage:
AppXl.ActiveSheet.Paste

' Converti la plage en Tableau Structuré:
Call TS_ConvertirPlageEnTS(AppXl.ActiveSheet.Range("A1"), TS.ListObject.DisplayName, TS.Parent.ListObjects(TS.ListObject.Name).TableStyle, xlYes)
AppXl.ActiveSheet.Range("A1").Select

' Sauvegarde le fichier et ferme l'instance:
AppXl.ActiveWorkbook.SaveAs FichierDest
AppXl.ActiveWorkbook.Close
Set AppXl = Nothing

Case TS_PDF

' Contrôle la présence de l'extension et supprime le fichier existant:
If UCase(Right(FichierDest, 4)) <> ".PDF" Then FichierDest = FichierDest & ".pdf"
If Dir(FichierDest) <> "" Then Kill FichierDest

' Création d'un fichier au format PDF:
Rng.ExportAsFixedFormat xlTypePDF, FichierDest

Case TS_BMP, TS_JPG

' Contrôle la présence de l'extension et supprime le fichier existant:
If FormatFichier = TS_BMP Then
If UCase(Right(FichierDest, 4)) <> ".BMP" Then FichierDest = FichierDest & ".bmp"
Filtre = "BMP"
End If
If FormatFichier = TS_JPG Then
If UCase(Right(FichierDest, 4)) <> ".JPG" Then FichierDest = FichierDest & ".jpg"
Filtre = "JPG"
End If
If Dir(FichierDest) <> "" Then Kill FichierDest

' Copie les cellules dans le Presse-papiers en tant qu'image:
Rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture

' Création d'un objet image (de petite taille mais elle sera ajustée):
Set ObjPicture = Rng.Parent.ChartObjects.Add(10, 10, 10, 10)
Application.Goto [A1], True
DoEvents
With ObjPicture
.ShapeRange.Line.Visible = msoFalse                      ' Masque l'objet.
DoEvents
.Height = Rng.Height                                     ' Ajuste la hauteur.
.Width = Rng.Width                                       ' Ajuste la largeur.
DoEvents
.Chart.Paste                                             ' Colle le presse-papiers
DoEvents
.Chart.Export Filename:=FichierDest, Filtername:=Filtre  ' Exporte l'image
.Delete                                                  ' Supprime l'objet.
End With

Case Else

Err.Raise vbObjectError, , "Le type d'exportation demandé n'est pas géré."

End Select

' Renvoie Vrai:
TS_ExporterEnFichier = True

' Fin du traitement:
Gest_Err:
Sh.Activate
Application.ScreenUpdating = Anc_ScreenUpdating
Sheets(TS.Parent.Name).Visible = Anc_Visible
Application.Cursor = xlDefault
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ExporterEnFichier", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ExporterEnFichier"
End If
Err.Clear

' S'il faut ouvrir le fichier:
If TS_ExporterEnFichier = True And OuvrirFichier = True And TS_Err_Number = 0 _
Then Call Shell("Explorer.exe " & FichierDest, vbMaximizedFocus)

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

VI-D - TS_EnregistrerDansAccess

La fonction TS_EnregistrerDansAccess enregistre un tableau structuré ou certaines de ses colonnes dans une base Access. Les éventuels enregistrements de la table préalablement créée ne sont pas effacés, les nouveaux enregistrements issus du tableau structuré y sont ajoutés. La fonction ne prend pas en charge les règles de gestion de la table Access, il conviendra donc de s'assurer que les données du tableau structuré sont cohérentes avec la table de destination pour ne pas générer une erreur d'importation dans Access.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- BaseAccess : le nom complet de la base Access (y compris son dossier) ;

- TableAccess : le nom de la table dans la base ;

- MotDePasse : éventuellement le mot de passe qui protège la base Access ;

- ListeChampsColonnes : la liste des couples sous forme d'un Array (c'est-à-dire entre guillemets et séparés par une virgule) des champs de la table et des colonnes du tableau structuré (voir exemple). S'il faut prendre une valeur fixe pour un champ et non pas la valeur de la colonne alors faire précéder le nom du champ par ">" (supérieur). Laissez vide pour prendre toutes les colonnes à l'identique des champs ;

- VisibleUniquement : si True alors ne traite que les lignes visibles, si False alors traite toutes les lignes même les masquées.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple d'utilisation :

Soit une base Access "P:\Test.accdb" avec une table "Table_1" qui contient les champs "A", "B" qu'il faut alimenter par les colonnes "Nom", "Prénom" du tableau structuré "TS_Eleves_1" pour toutes les lignes, même masquées :

Call TS_EnregistrerDansAccess(Range("TS_Eleves_1"), "P:\Test.accdb", "Table_1", "", Array("A", "Nom", "B", "Prénom"), False)

Si les champs de la table Access ont le même nom que les en-têtes du tableau structuré, il est possible de remplacer par :

Call TS_EnregistrerDansAccess(Range("TS_Eleves_1"), "P:\Test.accdb", "Table_1", "", "", False)

c'est-à-dire sans renseigner l'argument "ListeChampsColonnes".

Pour forcer une valeur fixe pour un champ et non pas la valeur de la cellule de la colonne, faire précéder le nom du champ par ">" (supérieur).
Exemple pour ajouter l'utilisateur en cours (obtenu par Application.UserName) dans le champ "Qui" :

Call TS_EnregistrerDansAccess(Range("TS_Eleves"), "P:\Test.accdb", "Table_1", "", Array("Nom", "Nom", "Prénom", "Prénom", ">Qui", Application.UserName), False)

Cliquez sur « Afficher le code » pour voir le code de la fonction

'----------
Public Function TS_EnregistrerDansAccess(TS As Range, _
BaseAccess As String, TableAccess As String, MotDePasse As String, _
ListeChampsColonnes As Variant, _
VisibleUniquement As Boolean) As Boolean
'-----------------------------------------------------------------------------------------------
' Enregistre un tableau structuré (ou certaines de ses colonnes) dans une base Access.
'-----------------------------------------------------------------------------------------------
' TS : le tableau structuré.
' BaseAccess : le nom complet de la base Access.
' TableAccess : le nom de la table dans la base.
' MotDePasse : éventuellement le mot de passe qui protège la base Access.
' ListeChampsColonnes : la liste des couples sous forme d'un array (c'est-à-dire entre guillemets et séparés par
'                       une virgule) des champs de la table et des colonnes du tableau structuré (voir exemple).
'                       S'il faut prendre une valeur fixe pour un champ et non pas la valeur de la colonne alors
'                       faire précéder le nom du champ par ">" (supérieur).
'                       Laissez vide pour prendre toutes les colonnes à l'identique des champs.
' VisibleUniquement : Si VRAI ne traite que les lignes visibles.
'-----------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'-----------------------------------------------------------------------------------------------
' Exemple d'utilisation :
' Soit une base Access "P:\Test.accdb" avec une table "Table_1" qui contient les champs "A", "B" qu'il faut alimenter par
' les colonnes "Nom", "Prénom" d'un du tableau structuré "TS_Eleves" pour toutes les lignes, même masquées.
' Call TS_EnregistrerDansAccess(Range("TS_Eleves"), "P:\Test.accdb", "Table_1", "", Array("A", "Nom", "B", "Prénom"), False)
' Si les champs de la table Access ont le même nom que les en-têtes du tableau structuré, il est possible de remplacer
' Call TS_EnregistrerDansAccess(Range("TS_Eleves"), "P:\Test.accdb", "Table_1", "", Array("Nom", "Nom", "Prénom", "Prénom"), False)
' par Call TS_EnregistrerDansAccess(Range("TS_Eleves"), "P:\Test.accdb", "Table_1", "", "", False) c'est-à-dire sans renseigner
' l'argument "ListeChampsColonnes".
' Pour forcer une valeur fixe pour un champ et non pas la valeur de la cellule de la colonne, faire précéder le nom du champ
' par  ">" (supérieur). Exemple pour ajouter l'utilisateur en cours dans le champ "Qui" :
' Call TS_EnregistrerDansAccess(Range("TS_Eleves"), "P:\Test.accdb", "Table_1", "", Array("Nom", "Nom", "Prénom", "Prénom", ">Qui", Application UserName), False)
'-----------------------------------------------------------------------------------------------
' La liaison anticipée nécessite d'installer la référence : Microsoft ActiveX Data Objects 6.0 Library
' La liaison tardive permet de ne pas référencer la bibliothèque ADO.
' L’instanciation d’objets à l’aide de la liaison tardive est généralement plus lente
' que l’utilisation de la liaison anticipée.
' Ici la liaison tardive a été adoptée uniquement pour vous éviter d'installer manuellement une
' référence et donc simplifier la portabilité du code.
' Les remarques ci-dessous indiquent comment adapter le code pour une liaison anticipée.
'------------------------------------------------------------------------------------------------
Dim y As Long
Dim i As Integer
Dim x As Integer
Dim Anc_Cursor As Long
Dim Anc_StatusBar As Variant

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

' S'il faut prendre toutes les colonnes du TS pour alimenter les champs de la table Access
' qui ont exactement le même nom que les en-têtes des colonnes:
If IsArray(ListeChampsColonnes) = False Then
i = TS_Nombre_Colonnes(TS) * 2
ReDim ListeChampsColonnes(0 To i - 1)
For i = 0 To UBound(ListeChampsColonnes) Step 2
x = x + 1
ListeChampsColonnes(i) = TS.ListObject.HeaderRowRange(x).Value
ListeChampsColonnes(i + 1) = TS.ListObject.HeaderRowRange(x).Value
Next i
End If

' Mémorise la présentation:
Anc_Cursor = Application.Cursor
Application.Cursor = xlWait
Anc_StatusBar = Application.StatusBar
Application.StatusBar = "Connexion à la base Access [" & BaseAccess & "]..."

' Connexion à la Base Access:
If TS_Cnn_Initialise(BaseAccess, MotDePasse) = False Then
Err.Raise vbObjectError, "", "Connexion à la base Access [" & BaseAccess & "] impossible. Veuillez contacter votre administrateur."
End If

' Ouverture d'une connexion:
If Cnn_TS.State = 0 Then Cnn_TS.Open    ' => adStateClosed
If Cnn_TS.State >= 2 Then               ' => adStateConnecting
While (Cnn_TS.State = 2): DoEvents: Wend
End If

' Ouverture d'un jeu d'enregistrements:
Dim MonRs As Variant ' => ADODB.Recordset
Set MonRs = CreateObject("ADODB.Recordset") ' => New ADODB.Recordset
MonRs.Open "SELECT * FROM [" & TableAccess & "]", Cnn_TS, 1, 2, 1 ' => adOpenKeyset, adLockPessimistic, adCmdText

' Boucle sur les lignes du Tableau Structuré:
For y = 1 To TS_Nombre_Lignes(TS)

' Progression:
Application.StatusBar = "Traitement ligne " & y & " sur " & TS_Nombre_Lignes(TS)
DoEvents

' Si la ligne est concernée:
If (VisibleUniquement = True And TS.ListObject.DataBodyRange(y, 1).Height > 0) Or VisibleUniquement = False Then

' Nouvel enregistrement:
MonRs.AddNew

' Boucle sur les champs de la table Access concernés pour les alimenter avec les colonnes du TS:
For i = LBound(ListeChampsColonnes) To UBound(ListeChampsColonnes) Step 2
' S'il faut prendre la valeur de la cellule de la colonne:
If Left(ListeChampsColonnes(i), 1) <> ">" Then
MonRs.Fields(ListeChampsColonnes(i)).Value = TS_InfoCellule(TS, ListeChampsColonnes(i + 1), y, TS_valeur)
' S'il faut prendre une valeur fixe pour alimenter le champ de la table:
Else
MonRs.Fields(Mid(ListeChampsColonnes(i), 2)).Value = ListeChampsColonnes(i + 1)
End If
Next i

' Enregistre:
MonRs.Update

End If

Next y

' Fermeture de la base:
MonRs.Close
Cnn_TS.Close

' Renvoie VRAI si tout s'est bien passé:
TS_EnregistrerDansAccess = True

' Fin du traitement:
Gest_Err:
If MonRs Is Nothing = False Then Set MonRs = Nothing

Set Cnn_TS = Nothing
Application.StatusBar = Anc_StatusBar
Application.Cursor = Anc_Cursor

TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_EnregistrerDansAccess", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_EnregistrerDansAccess"
End If
Err.Clear

End Function

'-----------------------------------------------------------------------------------------------
Private Function TS_Cnn_Initialise(StrBaseSource As String, MotDePasse As String) As Boolean
'-----------------------------------------------------------------------------------------------
' Ouvre une connexion avec la méthode ADO sur une base ACCESS.
' StrBaseSource = Base concernée (chemin complet + nom avec l'extension).
' MotDePasse = le mot de passe pour la connexion à la base.
' Renvoie : VRAI si connexion réussie ou FAUX si erreur.
'-----------------------------------------------------------------------------------------------
' Gestion des erreurs:
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, , "La base """ & StrBaseSource & """ n'a pas été trouvée."
End If

' Paramètres de connexion:
Set Cnn_TS = CreateObject("ADODB.Connection") ' => New ADODB.Connection
Cnn_TS.CommandTimeout = 30
Cnn_TS.CursorLocation = 2 ' => adUseServer
Application.StatusBar = "Demande de connexion...": DoEvents

' Détermine le fournisseur pour les bases .accdb, ou .mdb:
If MotDePasse = "" Then ' Sans mot de passe:
Cnn_TS.Open "Provider= " & Provider_ACCDB & ";" _
& "Data Source=" & StrBaseSource & ";" _
, "Admin", "", 16 ' => adAsyncConnect

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

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

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

' Gestion des erreurs:
Gest_Err:

' Désactiver la connexion:
If Cnn_TS Is Nothing = False Then
If Cnn_TS.State = 1 Then Cnn_TS.Close ' => adStateOpen
End If

Application.StatusBar = ""
Err.Clear

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

VI-E - TS_ImporterDepuisAccess

La fonction TS_ImporterDepuisAccess recopie les enregistrements d'une table ou d'une requête d'une base Access dans un tableau structuré.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré (s'il n'y pas assez de colonnes dans le tableau pour recevoir les données importées elles seront ajoutées automatiquement) ;

- BaseAccess : le nom complet de la base Access (y compris son dossier) ;

- MotDePasse : éventuellement le mot de passe qui protège la base Access ;

- ListeDesChamps : la liste des champs à récupérer, séparés par une virgule. Mettre les champs entre des crochets ouverts "[" et fermés "]" s'ils contiennent des espaces. Laissez à vide pour reprendre tous les champs ;

- SQLWhere : la requête d'instruction en langage SQL permettant d'identifier la sélection (sans le mot clé WHERE). Si SQLWhere vaut "" alors toute la table est sélectionnée ;

- Méthode : indique si les données importées doivent remplacer celles existantes dans le tableau structuré ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes ;

- Connexion : (facultatif) si renseigné alors utilise la connexion existante indiquée, ceci permet de gagner du temps en évitant de demander une nouvelle connexion à la base Access, par exemple Cnn_1.

La fonction renvoie : le nombre de lignes importées ou -1 en cas d'erreur.

Exemple d'utilisation pour importer dans le tableau structuré « TS_Eleves » tous les champs de la table des élèves « Eleves » de la base Access « Ecole.accdb » dont la note est supérieure à 10 (et effacer les éventuelles données antérieures) :

Call TS_ImporterDepuisAccess(Range("TS_Eleves"), "C:\Access\Ecole.accdb", "Eleves", "", "", "Note>10", TS_RemplacerDonnées)

Si besoin vous trouverez en Annexe 1 plus d'informations sur le langage SQL.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ImporterDepuisAccess(TS As Range, _
BaseAccess As String, TableAccess As String, MotDePasse As String, _
ByVal ListeDesChamps As Variant, ByVal SQLWhere As String, _
ByVal Méthode As Enum_CopierDonnées, _
Optional Connexion As Variant) As Long
'-----------------------------------------------------------------------------------------------
' Lit les enregistrements d'une table ou d'une requête d'une base Access.
' Les champs peuvent être définis dans ListeDesChamps ou tous sont repris si "" est indiqué.
' Les données sont recopiées dans le tableau structuré en remplacement des données existantes ou ajoutées.
'-----------------------------------------------------------------------------------------------
' TS : le tableau structuré où importer les données issues d'Access.
'      S'il n'y pas assez de colonnes dans le tableau elles sont ajoutées.
' BaseAccess : le nom complet de la base Access.
' TableAccess : le nom de la table dans la base.  Si vide alors prend la requette dans SQLWhere.
' MotDePasse : éventuellement le mot de passe qui protège la base Access.
' ListeDesChamps : la liste des Champs à récupérer, séparés par une virgule. Mettre les champs entre des crochets
'                  ouverts "[" et fermés "]" s'ils contiennent des espaces.
'                  Laissez à vide pour reprendre tous les champs.
' 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.
' Méthode : énumération Enum_CopierDonnées =
'           TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
'           TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
' Connexion : Si une connexion est déjà initialisée alors la renseigner pour gagner du temps de traitement
'             en évitant une nouvelle demande d'initialisation, par exemple Cnn_1.
'-----------------------------------------------------------------------------------------------
' Renvoie : le nombre de lignes importées ou -1 en cas d'erreur.
'-----------------------------------------------------------------------------------------------
' Exemple pour importer dans le tableau structuré TS_Eleves tous les champs de la table des élèves "Eleves"
' de la base Access "Ecole.accdb" dont la note est supérieure à 10 (et effacer les éventuelles données antérieures):
' TS_ImporterDepuisAccess(Range("TS_Eleves"), "C:\Access\Ecole.accdb", "Eleves", "", "", "Note>10", TS_RemplacerDonnées)
'-----------------------------------------------------------------------------------------------
' Mémorise la configuration:
Dim Anc_Screen As Boolean
Dim Anc_Cursor As Long
Dim Anc_StatusBar As Variant
Dim NbOrigine As Long, NbColonnes As Long

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

' Mémorise la présentation:
Anc_Cursor = Application.Cursor
Application.Cursor = xlWait
Anc_StatusBar = Application.StatusBar
Application.StatusBar = "Connexion à la base Access [" & BaseAccess & "]..."
Anc_Screen = Application.ScreenUpdating
Application.ScreenUpdating = False

' Connexion à la Base Access:
If IsMissing(Connexion) = False Then
Set Cnn_TS = Connexion
Else
If TS_Cnn_Initialise(BaseAccess, MotDePasse) = False Then
Err.Raise vbObjectError, "", "Connexion à la base Access [" & BaseAccess & "] impossible. Veuillez contacter votre administrateur."
End If
End If

' Ouverture d'une connexion:
If Cnn_TS.state = 0 Then Cnn_TS.Open    ' => adStateClosed
If Cnn_TS.state >= 2 Then               ' => adStateConnecting
While (Cnn_TS.state = 2): Application.StatusBar = "Attente de connexion...": DoEvents: Wend
Application.StatusBar = "": DoEvents
End If

' Ouverture d'un jeu d'enregistrements:
Dim MonRs As Variant                        ' => ADODB.Recordset
Set MonRs = CreateObject("ADODB.Recordset") ' => New ADODB.Recordset

' Ouverture de la table, avec ou sans requête SQLWhere, en lecture seule:
If ListeDesChamps = "" Then ListeDesChamps = "*"
If TableAccess <> "" Then
MonRs.Open "SELECT " & ListeDesChamps & " FROM [" & TableAccess & "]" & IIf(SQLWhere > "", " WHERE " & SQLWhere, "") _
, Cnn_TS, 1, 2, 1 ' => adOpenKeyset, adLockPessimistic, adCmdText
Else
MonRs.Open SQLWhere, Cnn_TS, 1, 2, 1              ' => adOpenKeyset, adLockPessimistic, adCmdText
End If

' Si des données existent:
If Not MonRs Is Nothing Then

' Efface les filtres existants:
Call TS_Filtres_Effacer(TS)

' Initialise le tableau s'il est vierge:
If TS.ListObject.ListRows.Count = 0 Then
Set TS = TS.ListObject.ListRows.Add.Range
Méthode = TS_RemplacerDonnées
End If

' Suivant s'il faut faire un remplacement des données ou un ajout aux données existantes:
Select Case Méthode

Case TS_RemplacerDonnées

Call TS_EffacerToutesLignes(TS)
Call TS_SupprimerPlusieursLignes(TS, 2, 0)
' Ajoute des colonnes s'il y en a pas assez dans le TS:
For NbColonnes = TS.Columns.Count + 1 To MonRs.Fields.Count
Call TS_AjouterUneColonne(TS, 0, "")
Next NbColonnes
' Pose les données issues d'Access:
TS.ListObject.DataBodyRange.CopyFromRecordset MonRs
NbOrigine = 0

Case TS_AjouterDonnées

' Compte le nombre de lignes avant l'ajout des données:
NbOrigine = TS.ListObject.ListRows.Count
' Ajoute des colonnes s'il y en a pas assez dans le TS:
For NbColonnes = TS.Columns.Count + 1 To MonRs.Fields.Count
Call TS_AjouterUneColonne(TS, 0, "")
Next NbColonnes
' Copie les données existantes:
Dim Copie As Variant
Copie = TS.ListObject.DataBodyRange.Formula
' Pose les données issues d'Access:
TS.ListObject.DataBodyRange.CopyFromRecordset MonRs
' Mémorise ces données:
Dim Ajout As Variant
Ajout = TS.ListObject.DataBodyRange.value
' Remet les anciennes données:
TS.ListObject.DataBodyRange.Formula = Copie
' Pose à la suite les nouvelles données:
TS.Cells(TS.Rows.Count + 1, 1).Resize(UBound(Ajout), UBound(Ajout, 2)) = Ajout

End Select

End If

' Fermeture de la base:
MonRs.Close
Cnn_TS.Close

' Renvoie le nombre de données importées:
TS_ImporterDepuisAccess = TS_Nombre_Lignes(TS) - NbOrigine

' Fin du traitement:
Gest_Err:
If MonRs Is Nothing = False Then Set MonRs = Nothing
Set Cnn_TS = Nothing
Application.StatusBar = Anc_StatusBar
Application.Cursor = Anc_Cursor
Application.ScreenUpdating = Anc_Screen

TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then TS_ImporterDepuisAccess = -1
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ImporterDepuisAccess", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ImporterDepuisAccess"
End If
Err.Clear

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

VI-F - TS_RequeteBaseAccess

La fonction TS_RequeteBaseAccess permet de faire des requêtes sur les enregistrements d'une base Access.

Ses arguments sont :

- BaseAccess : le nom complet de la base Access (y compris son dossier) ;

- MotDePasse : éventuellement le mot de passe qui protège la base Access ;

- StrSQL : la requête d'instruction en langage SQL.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple d'utilisation pour supprimer tous les enregistrements de table "T_Notes" dans la base Eleves (à utiliser avant d'y copier de nouveaux enregistrements en remplacement des anciens, voir le chapitre précédent) :

Call TS_RequeteBaseAccess("P:\Eleves.accdb"), "", "DELETE * FROM [T_Notes]")

Si besoin vous trouverez en Annexe 1 plus d'informations sur le langage SQL.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_RequeteBaseAccess(BaseAccess As String, MotDePasse As String, _
StrSQL As String) As Boolean
'-----------------------------------------------------------------------------------------------
' Fait une requête sur une table d'une base Access.
'-----------------------------------------------------------------------------------------------
' BaseAccess : le nom complet de la base Access.
' MotDePasse : éventuellement le mot de passe qui protège la base Access.
' StrSQL : Requête d'instruction.
'-----------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'-----------------------------------------------------------------------------------------------
' Exemple pour supprimer les enregistrements de la table "T_Notes" dans la base Eleves:
' Call TS_RequeteBaseAccess("P:\Eleves.accdb"), "", "DELETE * FROM [T_Notes]")
'-----------------------------------------------------------------------------------------------
' Mémorise la configuration:
Dim Anc_Screen As Boolean
Dim Anc_Cursor As Long
Dim Anc_StatusBar As Variant

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

' Mémorise la présentation:
Anc_Cursor = Application.Cursor
Application.Cursor = xlWait
Anc_StatusBar = Application.StatusBar
Application.StatusBar = Left("Connexion à la base Access [" & BaseAccess & "]...", 99)
Anc_Screen = Application.ScreenUpdating
Application.ScreenUpdating = False

' Connexion à la Base Access:
If TS_Cnn_Initialise(BaseAccess, MotDePasse) = False Then
Err.Raise vbObjectError, "", "Connexion à la base Access [" & BaseAccess & "] impossible. Veuillez contacter votre administrateur."
End If

' Ouverture d'une connexion:
If Cnn_TS.State = 0 Then Cnn_TS.Open    ' => adStateClosed
If Cnn_TS.State >= 2 Then               ' => adStateConnecting
While (Cnn_TS.State = 2): DoEvents: Wend
End If

' Requête:
Application.StatusBar = Left("Requête: " & StrSQL, 99)
Cnn_TS.Execute StrSQL

' Fermeture de la base:
Cnn_TS.Close

' Renvoie Vrai:
TS_RequeteBaseAccess = True

' Fin du traitement:
Gest_Err:
Set Cnn_TS = Nothing
Application.StatusBar = Anc_StatusBar
Application.Cursor = Anc_Cursor
Application.ScreenUpdating = Anc_Screen

TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_RequeteBaseAccess", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_RequeteBaseAccess"
End If
Err.Clear

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

VI-G - TS_CopierUneColonne

La fonction TS_CopierUneColonne copie une colonne d'un tableau structuré dans un autre tableau structuré.

Ses arguments sont :

- TS_Source : la plage (de type Range) du tableau structuré source où se trouve la colonne à copier ;

- Colonne_Source : le nom ou le numéro de la colonne à copier. Si zéro, alors la dernière colonne du tableau est traitée, si vide alors toutes les colonnes sont traitées ;

- TS_Dest : la plage (de type Range) du tableau structuré destination où il faut copier la colonne (la feuille doit être active) ;

- Colonne_Dest : le nom ou le numéro de la colonne où copier les données. Si zéro, alors la dernière colonne du tableau est traitée ;

- Ligne_Dest : ligne où coller la copie, par exemple 1 pour coller à la première ligne du tableau, ou 0 pour la dernière ligne du tableau ;

- CellType : (optionnel) énumération XlCellType par défaut xlCellTypeVisible pour les cellules visibles uniquement ;

- PasteType : (optionnel) énumération https://learn.microsoft.com/fr-fr/office/vba/api/excel.xlpastetype par défaut xlPasteValuesAndNumberFormats pour les valeurs avec leur format.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Remarque : si vous utilisez la méthode xlCellTypeVisible (par défaut) pensez à effacer les filtres du tableau structuré source si vous voulez copier toutes les données de la colonne et pas uniquement les cellules visibles.

Exemple pour sélectionner les élèves admis du tableau « TS_Eleves_1 » et recopier les colonnes « Nom » et « Prénom » dans le tableau « TS_Eleves_2 » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Dim Destination As Range

Set Tableau = Range("TS_Eleves_1")
Set Destination = Range("TS_Eleves_2")

' Filtre les Admis = OK du tableau source:
Call TS_Filtres_Effacer(Tableau)
Call TS_Filtres_Poser(Tableau, "Admis", "Ok")

' Effacer les lignes du tableau destination:
Call TS_EffacerToutesLignes(Destination)
Call TS_SupprimerPlusieursLignes(Destination, 2, 0)

' Recopie les élèves dans le tableau destination:
Call TS_CopierUneColonne(Tableau, "Nom", Destination, "Nom", 1, xlCellTypeVisible)
Call TS_CopierUneColonne(Tableau, "Prénom", Destination, "Prénom", 1, xlCellTypeVisible)

' Efface le filtre sur Admis:
Call TS_Filtres_Effacer(Tableau)

' Se place sur le premier nom du tableau destination:
Call TS_Sélectionner(Destination, 1, 1)

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

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_CopierUneColonne(TS_Source As Range, ByVal Colonne_Source As Variant, _
TS_Dest As Range, ByVal Colonne_Dest As Variant, ByVal Ligne_Dest As Long, _
Optional CellType As XlCellType = xlCellTypeVisible, _
Optional PasteType As XlPasteType = xlPasteValues) As Boolean
'------------------------------------------------------------------------------------------------------
' Copie une colonne d'un tableau structuré dans un autre tableau structuré.
'------------------------------------------------------------------------------------------------------
' TS_Source : le tableau structuré source où se trouve la colonne à copier.
' Colonne_Source : la colonne à copier (son nom ou son numéro).
'                  Si vide ("") alors copie toutes les colonnes.
' TS_Dest : le tableau structuré destination où il faut copier la colonne (la feuille doit être active).
' Colonne_Dest : la colonne où copier les données (son nom ou son numéro).
' Ligne_Dest : ligne où commencer la copie, par exemple 1 pour copier à la première ligne du tableau,
'              ou 0 pour la dernière ligne du tableau.
' CellType : énumération XlCellType (https://learn.microsoft.com/fr-fr/office/vba/api/excel.xlcelltype).
'            par défaut xlCellTypeVisible pour les cellules visibles uniquement.
' PasteType : énumération xlPasteValues, Type de données à copier.
'------------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Remarque : si vous utilisez CellType avec xlCellTypeVisible (par défaut) pensez à effacer les filtres du
' tableau structuré source si vous voulez copier toutes les données de la colonne et pas uniquement les
' cellules visibles.
'------------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Mémorise la configuration:
Dim Anc_Visible As Long
Dim Anc_Feuille As String
Dim Anc_Screen As Boolean

Anc_Visible = Sheets(TS_Dest.Parent.Name).Visible
Anc_Feuille = ActiveSheet.Name
Anc_Screen = Application.ScreenUpdating

' Contrôle la cohérence de la ligne destination passée en argument:
Ligne_Dest = TS_IndexLigne(TS_Dest, Ligne_Dest)
If Ligne_Dest = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' La feuille du tableau destination doit être activée pour coller des données:
Application.ScreenUpdating = False
Sheets(TS_Dest.Parent.Name).Visible = True
Sheets(TS_Dest.Parent.Name).Activate

' S'il faut copier toutes les colonnes:
If Colonne_Source = "" Then

Colonne_Source = 1
If TS_Dest.ListObject.ListRows.Count = 0 Then
Set TS_Dest = TS_Dest.ListObject.ListRows.Add.Range
TS_Dest.ListObject.DataBodyRange.Clear
End If
If Ligne_Dest = 0 Then Ligne_Dest = TS_Nombre_Lignes(TS_Dest)

While Colonne_Source <= TS_Nombre_Colonnes(TS_Source)

' Copie les données:
TS_Source.ListObject.ListColumns(Colonne_Source).DataBodyRange.SpecialCells(CellType).Copy

' Colle les données:
Call TS_Sélectionner(TS_Dest, Colonne_Source, Ligne_Dest)
Selection.PasteSpecial Paste:=PasteType, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

' Si destination n'a plus de colonne alors sort:
Colonne_Source = Colonne_Source + 1
If Colonne_Source > TS_Nombre_Colonnes(TS_Dest) Then
Colonne_Source = TS_Nombre_Colonnes(TS_Source) + 1
End If

Wend

Else ' S'il faut copier une seule colonne:

' Retrouve le numéro de la colonne source et vérifie sa cohérence (ou -1 si erreur):
Colonne_Source = TS_IndexColonne(TS_Source, Colonne_Source)
If Colonne_Source = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Retrouve le numéro de la colonne destination et vérifie sa cohérence (ou -1 si erreur):
Colonne_Dest = TS_IndexColonne(TS_Dest, Colonne_Dest)
If Colonne_Dest = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Copie les données:
TS_Source.ListObject.ListColumns(Colonne_Source).DataBodyRange.SpecialCells(CellType).Copy

' Colle les données:
Call TS_Sélectionner(TS_Dest, Colonne_Dest, Ligne_Dest)
Selection.PasteSpecial Paste:=PasteType, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

End If

' Renvoie Vrai:
TS_CopierUneColonne = True

' Fin du traitement:
Gest_Err:

' Restaure la configuration:
Sheets(TS_Dest.Parent.Name).Visible = Anc_Visible
Sheets(Anc_Feuille).Activate
Application.ScreenUpdating = Anc_Screen

If Err.Number = 1004 Then Err.Clear
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_CopierUneColonne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_CopierUneColonne"
End If
Err.Clear

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

VI-H - TS_CopierValeurColonne

La fonction TS_CopierValeurColonne copie en valeur une colonne d'un tableau structuré dans un autre tableau structuré, ou dans le même tableau, voire dans la même colonne ce qui équivaut dans ce cas à un copier/coller en valeur.
Les tableaux n'ont pas besoin d'être sur la feuille active ni sur la même feuille.

Ses arguments sont :

- TS_Source : la plage (de type Range) du tableau structuré source où se trouve la colonne à copier ;

- Colonne_Source : le nom ou le numéro de la colonne à copier. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée ;

- TS_Dest : la plage (de type Range) du tableau structuré destination où il faut copier la colonne ;

- Colonne_Dest : le nom ou le numéro de la colonne où copier les données. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée ;

- Méthode : indique si les données à copier doivent remplacer celles existantes dans le tableau structuré ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes ;

- VisibleUniquement : Si True seules les données visibles sont traitées, si False les données masquées sont prises en compte également.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Remarque : contrairement à la fonction TS_CopierUneColonne, la fonction TS_CopierValeurColonne ne copie que les valeurs, mais elle se révèle beaucoup plus rapide, c'est pourquoi je la préfère.

Exemple pour sélectionner les élèves admis du tableau « TS_Eleves_1 » et recopier les colonnes « Nom » et « Prénom » dans le tableau « TS_Eleves_2 » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Dim Destination As Range

Set Tableau = Range("TS_Eleves_1")
Set Destination = Range("TS_Eleves_2")

' Filtre les Admis = OK du tableau source:
Call TS_Filtres_Effacer(Tableau)
Call TS_Filtres_Poser(Tableau, "Admis", "Ok")

' Effacer les lignes du tableau destination:
Call TS_EffacerToutesLignes(Destination)
Call TS_SupprimerPlusieursLignes(Destination, 2, 0)

' Recopie les élèves dans le tableau destination:
Call TS_CopierValeurColonne(Tableau, "Nom", Destination, "Nom", TS_RemplacerDonnées, True)
Call TS_CopierValeurColonne(Tableau, "Prénom", Destination, "Prénom", TS_RemplacerDonnées, True)

' Efface le filtre sur Admis:
Call TS_Filtres_Effacer(Tableau)

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

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_CopierValeurColonne(TS_Source As Range, ByVal Colonne_Source As Variant, _
TS_Dest As Range, ByVal Colonne_Dest As Variant, _
Méthode As Enum_CopierDonnées, _
VisibleUniquement As Boolean) As Boolean
'------------------------------------------------------------------------------------------------------
' Copie en valeur une colonne d'un tableau structuré dans un autre tableau structuré (ou dans le même).
'------------------------------------------------------------------------------------------------------
' TS_Source : le tableau structuré source où se trouve la colonne à copier.
' Colonne_Source : la colonne à copier (son nom ou son numéro).
' TS_Dest : le tableau structuré destination où il faut copier la colonne.
' Colonne_Dest : la colonne où copier les données (son nom ou son numéro).
' Méthode : énumération Enum_CopierDonnées =
'           TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
'           TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
' VisibleUniquement : Si VRAI ne traite que les lignes visibles.
'------------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim Copie As Variant

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

' Retrouve le numéro de la colonne source et vérifie sa cohérence (ou -1 si erreur):
Colonne_Source = TS_IndexColonne(TS_Source, Colonne_Source)
If Colonne_Source = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Retrouve le numéro de la colonne destination et vérifie sa cohérence (ou -1 si erreur):
Colonne_Dest = TS_IndexColonne(TS_Dest, Colonne_Dest)
If Colonne_Dest = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Copie les données source:
Select Case VisibleUniquement
Case True:
Dim r As Range, i As Long, C As Range
Set r = TS_Source.ListObject.ListColumns(Colonne_Source).DataBodyRange.SpecialCells(xlCellTypeVisible)
ReDim Copie(1 To r.Count, 1 To 1)
For Each C In r
i = i + 1
Copie(i, 1) = C.Value
Next C
Case False:
Copie = TS_Source.ListObject.ListColumns(Colonne_Source).DataBodyRange.Value
End Select

' Efface les totaux:
Dim Anc_ShowTotals As Boolean
Anc_ShowTotals = TS_Dest.ListObject.ShowTotals
TS_Dest.ListObject.ShowTotals = False

' Place les données dans la destination:
Select Case Méthode
Case TS_AjouterDonnées:
TS_Dest.Cells(TS_Dest.Rows.Count + 1, Colonne_Dest).Resize(UBound(Copie), 1) = Copie
Case TS_RemplacerDonnées:
TS_Dest.ListObject.ListColumns(Colonne_Dest).DataBodyRange = ""
TS_Dest.Cells(1, Colonne_Dest).Resize(UBound(Copie), 1) = Copie
End Select

' Restaure les totaux:
TS_Dest.ListObject.ShowTotals = Anc_ShowTotals

' Renvoie VRAI:
TS_CopierValeurColonne = True

' Fin du traitement:
Gest_Err:
If Err.Number = 1004 Then Err.Clear ' Si rien a copier.
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_CopierValeurColonne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_CopierValeurColonne"
End If
Err.Clear

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

VI-I - TS_CopierUneLigne

La fonction TS_CopierUneLigne copie une ligne (en valeur ou en formule) d'un tableau structuré dans un autre tableau structuré, ou dans le même tableau.
Les tableaux n'ont pas besoin d'être sur la feuille active ni sur la même feuille.

Ses arguments sont :

- TS_Source : la plage (de type Range) du tableau structuré source où se trouve la ligne à copier ;

- Ligne_Source : le numéro de la ligne à copier. Si zéro alors la dernière ligne du tableau est traitée ;

- TS_Dest : la plage (de type Range) du tableau structuré destination où il faut copier la ligne ;

- Ligne_Dest : le nom de la ligne où copier les données. Si zéro alors la dernière ligne du tableau est traitée ;

- ValeursOuFormules : énumération Enum_ValeursOuFormules pour indiquer s'il faut copier les valeurs ou les formules :
- TS_Valeurs : copie des valeurs,
- TS_Formules : copie des formules,
- TS_FormulesLocales : copie des formules locales.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Remarque: Si le tableau destination à moins de colonnes que la source, la copie se limite aux colonnes existantes. S'il en a plus, les colonnes supplémentaires sont effacées.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_CopierUneLigne(TS_Source As Range, ByVal Ligne_Source As Long, _
TS_Dest As Range, ByVal Ligne_Dest As Long, _
Optional ValeursOuFormules As Enum_ValeursOuFormules = TS_Valeurs) As Boolean
'------------------------------------------------------------------------------------------------------
' Copie une ligne d'un tableau structuré dans un autre tableau structuré.
'------------------------------------------------------------------------------------------------------
' TS_Source : le tableau structuré source où se trouve la ligne à copier.
' Ligne_Source : le numéro de la ligne à copier.
' TS_Dest : le tableau structuré destination où il faut copier la ligne.
' Ligne_Dest : ligne où recopier la ligne, par exemple 1 pour copier à la première ligne du tableau,
'              ou 0 pour la dernière ligne du tableau.
' ValeursOuFormules : énumération Enum_ValeursOuFormules =
'                     TS_Valeurs : en valeurs (par défaut).
'                     TS_Formules : en formules (les en-têtes doivent être les mêmes dans les deux tableaux).
'                     TS_FormulesLocales : en formules (les en-têtes doivent être les mêmes dans les deux tableaux).
'------------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Remarque: Si le tableau destination à moins de colonnes que la source, la copie se limite aux colonnes
' existantes. S'il en a plus, les colonnes supplémentaires sont effacées.
'------------------------------------------------------------------------------------------------------
Dim x As Integer, xx As Integer

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

' Contrôle la cohérence de la ligne source passée en argument:
Ligne_Source = TS_IndexLigne(TS_Source, Ligne_Source)
If Ligne_Source = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Contrôle la cohérence de la ligne destination passée en argument:
Ligne_Dest = TS_IndexLigne(TS_Dest, Ligne_Dest)
If Ligne_Dest = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Efface les éventuelles données dans la destination:
TS_Dest.ListObject.DataBodyRange.Rows(Ligne_Dest).Clear

' Copie la ligne source:
xx = TS_Nombre_Colonnes(TS_Source)
If xx > TS_Nombre_Colonnes(TS_Dest) Then xx = TS_Nombre_Colonnes(TS_Dest)
For x = 1 To xx
Select Case ValeursOuFormules
Case TS_Valeurs
TS_Dest.ListObject.DataBodyRange(Ligne_Dest, x).Value = _
TS_Source.ListObject.DataBodyRange(Ligne_Source, x).Value
Case TS_Formules
TS_Dest.ListObject.DataBodyRange(Ligne_Dest, x).Formula = _
TS_Source.ListObject.DataBodyRange(Ligne_Source, x).Formula
Case TS_FormulesLocales
TS_Dest.ListObject.DataBodyRange(Ligne_Dest, X).FormulaLocal = _
TS_Source.ListObject.DataBodyRange(Ligne_Source, X).FormulaLocal
End Select
Next x

' Renvoie Vrai:
TS_CopierUneLigne = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_CopierUneLigne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_CopierUneLigne"
End If
Err.Clear

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

VI-J - TS_CopierTableau

La fonction TS_CopierTableau copie l'intégralité d'un tableau structuré (avec ou sans les colonnes masquées) dans un autre tableau structuré. Les données copiées sont soit les valeurs soit les formules, ou autres.
.

Ses arguments sont :

- TS_Source : le tableau structuré source à copier ;

- TS_Dest : le tableau structuré destination où il faut copier les données ;

- Méthode : énumération Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes ;

- CellType : (optionnel) énumération XlCellType par défaut xlCellTypeVisible pour les cellules visibles uniquement ;

- PasteType : (optionnel) énumération https://learn.microsoft.com/fr-fr/office/vba/api/excel.xlpastetype par défaut xlPasteValuesAndNumberFormats pour les valeurs avec leur format.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Remarques :
- Pour copier les formules avec TS_Formules les en-têtes doivent être les mêmes dans les deux tableaux et/ou les formules doivent être cohérentes avec le tableau de destination.
- Si le tableau source à plus de colonnes que le tableau destination : les colonnes en surplus sont ignorées.
- Si le tableau source à moins de colonnes que le tableau destination : les colonnes manquantes sont vides.

Exemple pour copier en valeur les données filtrées du tableau « TS_Eleves_1 » dans le tableau « TS_Eleves_2 » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Call TS_CopierTableau([TS_Eleves_1], [TS_Eleves_2], TS_RemplacerDonnées)
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_CopierTableau(TS_Source As Range, TS_Dest As Range, _
Méthode As Enum_CopierDonnées, _
Optional CellType As XlCellType = xlCellTypeVisible, _
Optional PasteType As XlPasteType = xlPasteValuesAndNumberFormats) As Boolean
'------------------------------------------------------------------------------------------------------
' TS_Source : le tableau structuré source à copier.
' TS_Dest : le tableau structuré destination où il faut copier les données.
' Méthode : énumération Enum_CopierDonnées =
'           TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
'           TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
' CellType : énumération XlCellType, par défaut xlCellTypeVisible pour les cellules visibles uniquement.
' PasteType : énumération xlPasteType, par défaut xlPasteValuesAndNumberFormats pour les valeurs avec leur format.
'------------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' S'il n'y a pas de lignes à copier alors sort:
If TS_ValeurColonne(TS_Source, 1, xlTotalsCalculationCount, True) = 0 Then
Exit Function
End If

' Place les données dans la destination:
Select Case Méthode
Case TS_AjouterDonnées: Call TS_AjouterUneLigne(TS_Dest)
Case TS_RemplacerDonnées: Call TS_SupprimerPlusieursLignes(TS_Dest, 2, 0): Call TS_EffacerToutesLignes(TS_Dest)
End Select

' Traitement:
TS_CopierTableau = TS_CopierUneColonne(TS_Source, "", TS_Dest, "", 0, CellType, PasteType)

' Gestion des erreurs:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_CopierTableau", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_CopierTableau"
End If
Err.Clear
End Function
'------------------------------------------------------------------------------------------------

VI-K - TS_CopierUnTableau

La fonction TS_CopierUnTableau copie l'intégralité d'un tableau structuré (y compris les colonnes masquées) dans un autre tableau structuré. Les données copiées sont soit les valeurs soit les formules.
La fonction gère aussi une source issue d'une plage mémorisée dans une variable (par la fonction TS_MémoriseTableau) ou d'un jeu d'enregistrements pour la copier en valeur dans un tableau structuré.

Ses arguments sont :

- TS_Source : la plage (de type Range) du tableau structuré source, ou des données mémorisées dans une variable ou un jeu d'enregistrements ;

- TS_Dest : la plage (de type Range) du tableau structuré destination ;

- Méthode : énumération Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes ;

- ValeursOuFormules : énumération Enum_ValeursOuFormules :
- TS_Valeurs : en valeurs (par défaut),
- TS_Formules : en formules (les en-têtes doivent être les mêmes dans les deux tableaux),
- TS_FormulesLocales : en formules locales (les en-têtes doivent être les mêmes dans les deux tableaux).

La fonction renvoie : le nombre de lignes ajoutées ou -1 si erreur.

Remarques :
- Pour copier les formules avec TS_Formules les en-têtes doivent être les mêmes dans les deux tableaux et/ou les formules doivent être cohérentes avec le tableau de destination.
- Si le tableau source à plus de colonnes que le tableau destination : les colonnes en surplus sont ignorées.
- Si le tableau source à moins de colonnes que le tableau destination : les colonnes manquantes sont vides.

Exemple pour copier en valeur les données du tableau « TS_Eleves_1 » dans le tableau « TS_Eleves_2 » (qui volontairement ne contient que trois colonnes):

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Dim Destination As Range

Set Tableau = Range("TS_Eleves_1")
Set Destination = Range("TS_Eleves_2")

Call TS_CopierUnTableau(Tableau, Destination, TS_RemplacerDonnées, TS_Valeurs)

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

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_CopierUnTableau(TS_Source As Variant, TS_Dest As Range, _
Méthode As Enum_CopierDonnées, _
Optional ValeursOuFormules As Enum_ValeursOuFormules = TS_Valeurs) As Long
'------------------------------------------------------------------------------------------------------
' Copie les données d'un tableau structuré (ou aussi d'une mémoire ou d'un jeu d'enregistrements) dans
' un autre tableau structuré.
'------------------------------------------------------------------------------------------------------
' TS_Source : le tableau structuré source, une mémoire, un jeu d'enregistrements.
' TS_Dest : le tableau structuré destination.
' Méthode : énumération Enum_CopierDonnées =
'           TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
'           TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
' ValeursOuFormules : énumération Enum_ValeursOuFormules =
'                     TS_Valeurs : en valeurs (par défaut).
'                     TS_Formules : en formules (les en-têtes doivent être les mêmes dans les deux tableaux).
'                     TS_FormulesLocales : en formules (les en-têtes doivent être les mêmes dans les deux tableaux).
'------------------------------------------------------------------------------------------------------
' Renvoie : le nombre de lignes ajoutées ou -1 si erreur.
'------------------------------------------------------------------------------------------------------
' Remarques :
' - TS_Source : peut être un tableau d'un autre classeur ouvert,
'               exemple : Workbooks("Classeur1.xlsm").Sheets("Feuil1").Range("T_1")
'               peut être un variant contenant les données du tableau,
'               exemple : Données = TS_MémoriseTableau(Workbooks("Classeur1.xlsm").Sheets("Feuil1").Range("T_1"), TS_Valeurs)
'                         Call TS_CopierUnTableau(Données, Range("TS_Importation"), TS_RemplacerDonnées, TS_Valeurs)
'               peut être un jeu d'enregistrements.
' - Pour copier les formules avec TS_Formules les en-têtes doivent être les mêmes dans les deux tableaux
' et/ou les formules doivent être cohérentes avec le tableau de destination.
' - Si le tableau source à plus de colonnes que le tableau destination : les colonnes en surplus sont ignorées.
' - Si le tableau source à moins de colonnes que le tableau destination : les colonnes manquantes sont vides.
'------------------------------------------------------------------------------------------------------
Dim Copie As Variant
Dim NbOrigine As Long

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

' Par défaut renvoie -1:
TS_CopierUnTableau = -1

' Mémorise les données de la source suivant son type:
Select Case TypeName(TS_Source)
Case "Range" ' Tableau Structuté
Copie = TS_MémoriseTableau(TS_Source, ValeursOuFormules)
Case "Recordset" ' Jeu d'enregistrement
Dim y As Long, x As Integer
' S'il est vide alors déclencher une erreur pour sortir du traitement:
If TS_Source.RecordCount = 0 Then Err.Raise 91
' Dimensionne la mémoire qui va contenir les données du jeu d'enregistrements:
ReDim Copie(1 To TS_Source.RecordCount, 1 To TS_Source.Fields.Count)
' Se place sur le 1° enregistrement (facultatif):
TS_Source.MoveFirst
' Boucle sur jeu d'enregistrements pour mémoriser les données:
For y = 1 To TS_Source.RecordCount
For x = 1 To TS_Source.Fields.Count
Copie(y, x) = TS_Source.Fields(x - 1).Value
If IsNumeric(Copie(y, x)) = True Then
If Len(Copie(y, x)) > 15 Then Copie(y, x) = "'" & Copie(y, x)
End If
Next x
TS_Source.MoveNext
Next y
Case Else ' Autres cas
Copie = TS_Source
End Select

' S'il y a des données:
If IsNull(Copie) = False Then

' Efface les totaux:
Dim Anc_ShowTotals As Boolean
Anc_ShowTotals = TS_Dest.ListObject.ShowTotals
TS_Dest.ListObject.ShowTotals = False

' Ajuste à la taille du tableau destination:
ReDim Preserve Copie(1 To UBound(Copie), 1 To TS_Nombre_Colonnes(TS_Dest))

' Suivant s'il faut faire un remplacement des données ou un ajout aux données existantes:
Select Case Méthode

Case TS_RemplacerDonnées

Call TS_Filtres_Effacer(TS_Dest)
Call TS_EffacerToutesLignes(TS_Dest)
NbOrigine = 0

' Dimensionne le tableau destination pour accueillir les données:
TS_Dest.ListObject.Resize Range(Cells(TS_Dest.Row - 1, TS_Dest.Column), Cells(TS_Dest.Row + UBound(Copie) - 1, TS_Dest.Column + TS_Dest.ListObject.ListColumns.Count - 1))
' S'il est vierge alors il faut l'initialiser:
If TS_Dest.ListObject.ListRows.Count = 0 Then
TS_Dest.ListObject.Resize Range(Cells(TS_Dest.Row - 1, TS_Dest.Column), Cells(TS_Dest.Row + 1, TS_Dest.Column + TS_Dest.ListObject.ListColumns.Count - 1))
TS_Dest.ListObject.DataBodyRange.Rows(2).Delete
End If
' Si la ligne des totaux est inclue dans la source:
While TS_Dest.ListObject.ListRows.Count < UBound(Copie): TS_Dest.ListObject.ListRows.Add: Wend

' Pose les données:
Select Case ValeursOuFormules
Case TS_Valeurs: TS_Dest.ListObject.DataBodyRange.Value = Copie
Case TS_Formules: TS_Dest.ListObject.DataBodyRange.Formula = Copie
Case TS_FormulesLocales: TS_Dest.ListObject.DataBodyRange.FormulaLocal = Copie
End Select

Case TS_AjouterDonnées

NbOrigine = TS_Nombre_Lignes(TS_Dest)
TS_Dest.Cells(NbOrigine + 1, 1).Resize(UBound(Copie), TS_Dest.Columns.Count) = Copie

End Select

' Restaure les totaux:
TS_Dest.ListObject.ShowTotals = Anc_ShowTotals

' Renvoie le nombre de données copiées:
TS_CopierUnTableau = TS_Nombre_Lignes(TS_Dest) - NbOrigine

End If

' Fin du traitement:
Gest_Err:
If Err.Number = 91 Then Err.Clear ' Pas d'enregistrements dans le jeu passé en argument.
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_CopierUnTableau", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_CopierUnTableau"
End If
Err.Clear

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

VI-L - TS_MémoriseTableau

La fonction TS_MémoriseTableau mémorise les données d'un tableau structuré dans un variant à plusieurs dimensions. Les données mémorisées sont soit les valeurs soit les formules.

Ses arguments sont :

- TS : la plage (de type Range) du tableau structuré ;

- ValeursOuFormules : énumération Enum_ValeursOuFormules :
- TS_Valeurs : en valeurs (par défaut),
- TS_Formules : en formules,
- TS_FormulesLocales : en formules locales.

La fonction renvoie : un Variant à plusieurs dimensions.

Remarque : la mémoire renvoyée sera utilisée pour analyser les données ou pour les recopier dans un autre tableau structuré comme le fait la fonction TS_CopierUnTableau.

Exemple pour mémoriser les données du tableau « TS_Eleves_1 » :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Dim Données As Variant

' Mémorise les valeurs du tableau TS_Eleves_1:
Set Tableau = Range("TS_Eleves_1")
Données = TS_MémoriseTableau(Tableau, TS_Valeurs)

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

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_MémoriseTableau(TS As Variant, Optional ValeursOuFormules As Enum_ValeursOuFormules = TS_Valeurs) As Variant
'------------------------------------------------------------------------------------------------------
' Mémorise les données d'un tableau structuré dans un variant à plusieurs dimensions.
' Voir l'exemple de la fonction TS_CopierUnTableau.
'------------------------------------------------------------------------------------------------------
' TS : le tableau structuré concerné.
' ValeursOuFormules : énumération Enum_ValeursOuFormules =
'                     TS_Valeurs : en valeurs (par défaut).
'                     TS_Formules : en formules.
'                     TS_FormulesLocales : en formules locales.
'------------------------------------------------------------------------------------------------------
' Renvoie : les données du tableau structuré dans une mémoire du type variant à plusieurs dimensions.
'------------------------------------------------------------------------------------------------------
' Remarque : les dates sont transformées en nombre car par défaut le format anglais est appliqué
' aux données mémorisées ce qui génère des erreurs lors de leur restitution.
'------------------------------------------------------------------------------------------------------
Dim Données As Variant

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

' Mémorise les données du tableau:
Select Case ValeursOuFormules
Case TS_Valeurs: Données = TS.ListObject.DataBodyRange.Value
Case TS_Formules: Données = TS.ListObject.DataBodyRange.Formula
Case TS_FormulesLocales: TS_MémoriseTableau = TS.ListObject.DataBodyRange.FormulaLocal: Exit Function
End Select

' Pour transformer les dates en nombre:
Dim x As Long, y As Long
For y = 1 To UBound(Données)
For x = 1 To UBound(Données, 2)
If IsError(Données(y, x)) = False Then
If Données(y, x) <> "" Then
If IsDate(TS.ListObject.DataBodyRange(y, X).Value) = True Then
Données(y, X) = CDec(Format(Données(y, X), "0.000000000000"))
End If
End If
End If
Next x
Next y

' Pour forcer le mode texte sur les nombres préfixés:
If ValeursOuFormules = TS_Valeurs Then
For y = 1 To UBound(Données)
For x = 1 To UBound(Données, 2)
If TS.ListObject.DataBodyRange(y, x).PrefixCharacter <> "" Then _
Données(y, x) = TS.ListObject.DataBodyRange(y, x).PrefixCharacter & Données(y, x)
Next x
Next y
End If

' Renvoie les données:
TS_MémoriseTableau = Données

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_MémoriseTableau", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_MémoriseTableau"
End If
Err.Clear

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

VI-M - TS_ImporterDepuisClasseur

Comme son nom l’indique la fonction TS_ImporterDepuisClasseur importe, dans un tableau structuré existant, les données d’un autre classeur. Les données sources peuvent être contenues soit dans une plage Excel classique, soit dans un tableau structuré.
L’importation peut porter sur l’intégralité des colonnes source ou sur certaines seulement.
Le fichier source peut être fermé ou déjà ouvert, mais normalement vous utiliserez cette fonction sur des classeurs fermés car pour les classeurs ouverts d’autres fonctions sont déjà proposées dans le module « TS ».

Pour éviter que les macros se lancent à l'ouverture du classeur avec l'événement Workbook_Open() nous les désactiverons en forçant le mode de sécurité par l'instruction Application.AutomationSecurity = msoAutomationSecurityForceDisable, puis nous les restaurerons avec le mode en cours préalablement mémorisé.

Ses arguments sont :

- Fichier_Source : le classeur Excel qui contient les sources (chemin complet + nom avec l'extension) ;

- MotDePasse : éventuellement le mot de passe pour ouvrir le fichier (vide si non nécessaire) ;

- Nom_Tableau_Source : soit le nom du tableau structuré qui contient les données source (pas un Range, voir exemple), soit le nom de la feuille entre crochets ouvert « [ » et fermé « ] » suivi d'un point d'exclamation « ! » (si la plage à un en-tête ou un dollar « $ » si la plage n’en a pas) et de la plage ou de la première cellule haut-gauche de la plage (voir exemple) ;

- TS_Dest : le tableau structuré destination (de type Range) situé dans le classeur contenant cette fonction ;

- Méthode : indique si les données importées doivent remplacer celles existantes dans le tableau structuré ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.

- ListeColonnes : (facultatif) le couple des noms des colonnes sources, noms (ou numéro) des colonnes destination, séparé par une virgule. Si vide alors les colonnes du tableau source sont copiées dans la destination sans ajout de colonnes supplémentaires si la destination n'a pas assez de colonnes.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Remarques sur la source Nom_Tableau_Source :

- si la source est un tableau structuré alors passez son nom, par exemple "Tableau1" et non pas un objet Range comme Range("Tableau1") ;

- si la source est une plage classique, passez le nom de la feuille et la plage, comme par exemple "[Feuil1]!A1" pour que la fonction étende automatiquement la plage, ou "[Feuil1]!A1:C99" pour prendre une plage déterminé ;

- la plage doit avoir un en-tête, si ce n'est pas le cas remplacez « ! » par « $ » ;

- si le tableau source à plus de colonnes que le tableau destination alors les colonnes en surplus sont ignorées ;

- si le tableau source à moins de colonnes que le tableau destination alors les colonnes manquantes sont vides.

Exemples d'appels de la fonction TS_ImporterDepuisClasseur pour importer des données du fichier « C:\Sources\Monfichier.xls » (qui n'a pas de mot de passe) et les coller en valeur dans le tableau structuré « TS_1 ».
Si vous utilisez Dim TS As Range : Set TS=Range("TS_1") alors remplacez Range("TS_1") par TS dans les exemples :

La source est une plage qui commence en « A1 » de la feuille « Feuil1 » et il faut remplacer les données existantes dans le tableau structuré destination « TS_1 » :
TS_ImporterDepuisClasseur("C:\Sources\Monfichier.xls", "", "[Feuil1]!A1", Range("TS_1"), TS_RemplacerDonnées)

Idem mais cette fois en ajoutant les données importées à celles existantes :
TS_ImporterDepuisClasseur("C:\Sources\Monfichier.xls", "", "[Feuil1]!A1", Range("TS_1"), TS_AjouterDonnées)

La source est aussi un tableau structuré nommé « TS_X » et il faut remplacer les données existantes :
TS_ImporterDepuisClasseur("C:\Sources\Monfichier.xls", "", "TS_X", Range("TS_1"), TS_RemplacerDonnées)

Idem mais ici il ne faut pas prendre toutes les colonnes mais seulement dans la source les colonnes « MATRICULE », « NOM », « PRENOM » que l'on place dans la destination en colonnes nommées « A », « B » et à la dernière colonne :
TS_ImporterDepuisClasseur("C:\Sources\Monfichier.xls", "", "TS_X", _ Range("TS_1"), TS_RemplacerDonnées, "MATRICULE", "A", "NOM", "B", "PRENOM", 0)

Le code de la fonction :

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Function TS_ImporterDepuisClasseur(ByVal Fichier_Source As String, MotDePasse As String, _
ByVal Nom_Tableau_Source As String, _
ByVal TS_Dest As Range, _
Méthode As Enum_CopierDonnées, _
ParamArray ListeColonnes() As Variant) As Boolean
'------------------------------------------------------------------------------------------------------
' Copie en valeur les données d'un tableau, structuré ou non structuré, issues d'un classeur Excel
' (théoriquement fermé mais s'il est déjà ouvert dans la même cession il ne sera pas refermé) dans un
' tableau structuré (existant) du classeur contenant ce code.
' Le classeur est ouvert pour copier la source mais les macros sont désactivées pour ouvrir le fichier sans
' lancer l'événement "Workbook_Open".
'------------------------------------------------------------------------------------------------------
' Fichier_Source : le classeur Excel qui contient les sources (chemin complet + nom avec l'extension).
' MotDePasse : éventuellement le mot de passe pour ouvrir le fichier (vide si non nécessaire).
' Nom_Tableau_Source : soit le nom du Tableau Structuré qui contient les données source (pas un Range, voir exemple),
'                      soit le nom de la feuille entre crochets "[" et "]" suivi d'un point d'exclamation "!"
'                      et de la plage ou de la première cellule haut-gauche de la plage (voir exemple).
' TS_Dest : le Tableau Structuré destination (de type Range) situé sur le classeur contenant cette fonction.
' Méthode : énumération Enum_CopierDonnées =
'           TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
'           TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
' ListeColonnes : (facultatif) le couple des noms des colonnes sources, noms (ou numéro) des colonnes destination,
'                 séparé par une virgule. Si vide alors les colonnes du tableau source sont copiées dans la
'                 destination sans ajout de colonnes supplémentaires si la destination n'a pas assez de colonnes.
'------------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Remarques :
' - Nom_Tableau_Source : Si la source est un tableau structuré alors passez son nom, par exemple "Tableau1" et
'                        non pas un objet Range de type comme Range("Tableau1").
'                        Si la source est une plage classique, passez le nom de la feuille et la plage, comme par
'                        exemple "[Feuil1]!A1" pour que la fonction étende automatiquement la plage,
'                        ou "[Feuil1]!A1:C99" pour prendre une plage déterminée.
'                        La plage doit avoir un en-tête, si ce n'est pas le cas remplacez "!" par "$".
' - Si le tableau source a plus de colonnes que le tableau destination : les colonnes en surplus sont ignorées.
' - Si le tableau source a moins de colonnes que le tableau destination : les colonnes manquantes sont vides.
'------------------------------------------------------------------------------------------------------
' Exemples d'appels pour importer des données du fichier "C:\Sources\Monfichier.xls" (qui n'a pas de mot de passe)
' et les coller en valeur dans le tableau structuré "TS_1":
' Si vous utilisez Dim TS As Range : Set TS=Range("TS_1") alors remplacez Range("TS_1") par TS dans les exemples.
' - La source est une plage qui commence en "A1" de la feuille "Feuil1" et il faut remplacer les données existantes
' dans le tableau structuré destination "TS_1":
' TS_ImporterDepuisClasseur("C:\Sources\Monfichier.xls", "", "[Feuil1]!A1", Range("TS_1"), TS_RemplacerDonnées)
' - Idem mais cette fois en ajoutant les données importées à celles existantes:
' TS_ImporterDepuisClasseur("C:\Sources\Monfichier.xls", "", "[Feuil1]!A1", Range("TS_1"), TS_AjouterDonnées)
' - La source est aussi un tableau structuré nommé "TS_X" et il faut remplacer les données existantes:
' TS_ImporterDepuisClasseur("C:\Sources\Monfichier.xls", "", "TS_X", Range("TS_1"), TS_RemplacerDonnées)
' - Idem mais ici il ne faut pas prendre toutes les colonnes mais seulement dans la source les colonnes "MATRICULE",
' "NOM", "PRENOM" que l'on place dans la destination en colonnes nommées "A", "B" et à la dernière colonne:
' TS_ImporterDepuisClasseur("C:\Sources\Monfichier.xls", "", "TS_X", Range("TS_1"), TS_RemplacerDonnées, "MATRICULE", "A", "NOM", "B", "PRENOM", 0)
'------------------------------------------------------------------------------------------------------
Dim Wk As Workbook
Dim TS_Source As Range
Dim AvecEntete As XlYesNoGuess
Dim i As Long
Dim Anc_ScreenUpdating As Boolean
Dim Classeurs As String, NomCourt As String

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
Set Wk = Nothing

' Désactive l'affiche écran:
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' Mémorise les classeurs ouverts:
For i = 1 To Workbooks.Count
Classeurs = Classeurs & ";" & Workbooks(i).Name & ";"
Next i

' Ouvre le classeur source en lecture seule s'il n'est pas déjà ouvert:
NomCourt = Mid(Fichier_Source, 1 + InStrRev(Fichier_Source, "\"))
If InStr(1, Classeurs, ";" & NomCourt & ";") = 0 Then
' Désactive les macros pour ouvrir le fichier sans lancer "Workbook_Open":
Dim secAutomation As MsoAutomationSecurity
secAutomation = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityForceDisable
' Ouvre le fichier:
Set Wk = Workbooks.Open(Fichier_Source, False, True, , MotDePasse)
' Réactive les macros:
Application.AutomationSecurity = secAutomation
Else ' ou l'active s'il est ouvert:
Workbooks(NomCourt).Activate
End If

' Supprime les crochets dans le nom du tableau source (pas besoin de ces crochets dans le traitement):
Nom_Tableau_Source = Replace(Nom_Tableau_Source, "[", "")
Nom_Tableau_Source = Replace(Nom_Tableau_Source, "]", "")
' Par défaut la plage a un en-tête sauf si "$" est utilisé:
AvecEntete = xlYes
If InStr(1, Nom_Tableau_Source, "$") > 0 Then AvecEntete = xlNo
' Remplace "$" par "!":
Nom_Tableau_Source = Replace(Nom_Tableau_Source, "$", "!")

' Analyse ce nom pour trouver la partie feuille et la partie plage (si ce coupe a été passé en argument):
i = InStr(1, Nom_Tableau_Source, "!")
Select Case i
' Si la source est le nom d'une feuille et d'une plage:
Case Is > 0
Dim Feuille As String, Plage As String
Feuille = Mid(Nom_Tableau_Source, 1, i - 1)
Plage = Mid(Nom_Tableau_Source, i + 1)
' Si la plage est connue alors la prendre:
If InStr(1, Plage, ":") > 0 Then
Set TS_Source = Sheets(Feuille).Range(Plage)
Else ' Sinon prendre la plage étendue automatiquement:
Set TS_Source = Sheets(Feuille).Range(Plage).CurrentRegion
End If
' Transforme la source en Tableau Structuré:
TS_Source.Parent.ListObjects.Add xlSrcRange, TS_Source, , AvecEntete
' Si la source est le nom d'un Tableau Structuré alors l'initialiser:
Case Else
Set TS_Source = Range(Nom_Tableau_Source)
Call TS_Filtres_Effacer(TS_Source)
End Select

' Efface les totaux:
Dim Anc_ShowTotals As Boolean
Anc_ShowTotals = TS_Dest.ListObject.ShowTotals
TS_Dest.ListObject.ShowTotals = False

' Copie les colonnes du tableau du fichier source dans les colonnes du fichier destination
' sans ajouter d'autres colonnes si la destination n'a pas assez de colonnes:
Select Case IsMissing(ListeColonnes)
Case True
If TS_CopierUnTableau(TS_Source, TS_Dest, Méthode, TS_Valeurs) >= 0 Then TS_ImporterDepuisClasseur = True
Case False
If UBound(ListeColonnes) <> 0 Then
Dim Copie As Variant, Colonne As Integer, Ligne As Long
' Trouve la position de la dernière ligne:
Ligne = TS_Dest.ListObject.ListRows.Count + 1
' S'il faut remplacer les données alors forcer la dernière ligne à 1 et supprimer les autres lignes:
If Méthode = TS_RemplacerDonnées Then
Ligne = 1
Call TS_SupprimerPlusieursLignes(TS_Dest, 2, 0)
End If
' Copie la première colonne (depuis la dernière ligne):
Call TS_CopierValeurColonne(TS_Source, ListeColonnes(0), TS_Dest, ListeColonnes(1), Méthode, False)
' Copie les autres colonnes (depuis la dernière ligne):
For i = 2 To UBound(ListeColonnes) Step 2
' Retrouve le numéro de la colonne source et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS_Source, ListeColonnes(i))
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
' Copie toutes les données de la colonne du tableau source:
Copie = TS_Source.ListObject.ListColumns(Colonne).DataBodyRange.Value
' Retrouve le numéro de la colonne destination et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS_Dest, ListeColonnes(i + 1))
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
' Colle les données dans la colonne du tableau destination:
TS_Dest.Cells(Ligne, Colonne).Resize(UBound(Copie), 1) = Copie
Next i
TS_ImporterDepuisClasseur = True
Else
If TS_CopierUnTableau(TS_Source, TS_Dest, Méthode, TS_Valeurs) >= 0 Then TS_ImporterDepuisClasseur = True
End If
End Select

' Restaure les totaux:
TS_Dest.ListObject.ShowTotals = Anc_ShowTotals

' Fin du traitement:
Gest_Err:

' Ferme le fichier sauf s'il était déjà ouvert avant cette fonction:
If Not Wk Is Nothing Then
If InStr(1, Classeurs, ";" & Wk.Name & ";") = 0 Then
Wk.Saved = True
Wk.Close False
End If
End If

' Restaure l'affichage d'origine:
Application.ScreenUpdating = Anc_ScreenUpdating

' Gestion des erreurs:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ImporterDepuisClasseur", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ImporterDepuisClasseur"
End If
Err.Clear

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

VI-N - TS_ImporterDepuisClasseurAvecSQL

La fonction TS_ImporterDepuisClasseurAvecSQL importe, dans un tableau structuré existant, les données d’un classeur qui est fermé et effectuant une requête SQL pour la sélection des données à importer.
Les données sources peuvent être contenues soit dans une plage Excel classique soit dans un tableau structuré.
Le fichier source peut être déjà ouvert, mais normalement vous utiliserez cette fonction sur des classeurs fermés car pour les classeurs ouverts d’autres fonctions sont déjà proposées dans le module « TS ».
Le tableau source doit obligatoirement avoir un en-tête avec des noms de champs uniques pour pouvoir exécuter une requête.
Le classeur n'est ouvert que s'il est protégé par mot de passe (pas d'autre façon de faire) ou si un tableau structuré est passé dans le nom du tableau source (afin de retrouver la feuille concernée), mais comme pour la fonction TS_ImporterDepuisClasseur les macros sont désactivées pour ouvrir le fichier sans lancer l'événement Workbook_Open.

Ses arguments sont :

- Fichier_Source : le classeur Excel qui contient les sources (chemin complet + nom avec l'extension) ;

- MotDePasseOuverture : éventuellement le mot de passe pour ouvrir le fichier (vide si non nécessaire) ;

- MotDePasseEcriture : éventuellement le mot de passe pour permettre les modifications dans le fichier (vide si non nécessaire) ;

- Nom_Tableau_Source : soit le nom du tableau structuré qui contient les données source (pas un Range, voir exemple), soit le nom de la feuille entre crochets ouvert « [ » et fermé « ] » (voir exemple) ;

- TS_Dest : le tableau structuré destination (de type Range) situé dans le classeur contenant cette fonction ;

- Méthode : indique si les données importées doivent remplacer celles existantes dans le tableau structuré ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.

- StrChamps : (facultatif) le nom des champs de la requête ou vide pour tout prendre ;

- StrSQL : (facultatif) la requête SQL.

La fonction renvoie : le nombre de lignes importées ou -1 si erreur.

Remarques sur la source Nom_Tableau_Source :

- si la source est un tableau structuré alors passez son nom, par exemple "Tableau1" et non pas un objet Range comme Range("Tableau1") ;

- si la source est une plage classique, passez le nom de la feuille et la plage, comme par exemple "[Feuil1]" pour un traitement sur la feuille nommée « Feuil1 » ;

- si le tableau source à plus de colonnes que le tableau destination alors les colonnes en surplus sont ignorées ;

- si le tableau source à moins de colonnes que le tableau destination alors les colonnes manquantes sont vides.

Exemples d'appels de la fonction TS_ImporterDepuisClasseurAvecSQL pour importer des données du fichier « C:\Sources\Monfichier.xls » (qui n'a pas de mot de passe) et les coller en valeur dans le tableau structuré « TS_1 ».
Si vous utilisez Dim TS As Range : Set TS=Range("TS_1") alors remplacez Range("TS_1") par TS dans les exemples :

La source est une plage de la feuille « Feuil1 » et il faut remplacer les données existantes dans le tableau structuré destination « TS_1 » par une requête SQL qui regroupe les données sources de la colonne « Référence » et les classe par ordre croissant :
Call TS_ImporterDepuisClasseurAvecSQL("C:\_Formation_VBA\Test.xlsm", "Mgx", "x", _ "[Feuil1]", Range("TS_1"), TS_RemplacerDonnées, _ "[Référence]", "GROUP BY [Référence] ORDER BY [Référence]")

Idem mais cette fois les données sources sont dans un tableau structuré nommé « Tableau1 » et il faut compter le nombre de fois que les groupes de « Référence » sont utilisés, et trier des plus utilisés aux moins utilisés :
Call TS_ImporterDepuisClasseurAvecSQL("C:\_Formation_VBA\Test.xlsm", "Mgx", "x", _ "Tableau1", Range("TS_1"), TS_RemplacerDonnées, _ "[Référence], Count([Référence])", "GROUP BY [Référence] ORDER BY count([Référence]) DESC")

Ou tout simplement importer toutes les données où « Montant » est supérieur à 100 :
Call TS_ImporterDepuisClasseurAvecSQL("C:\_Formation_VBA\Test.xlsm", "Mgx", "x", _ "Tableau1", Range("TS_1"), TS_RemplacerDonnées, _ "", "WHERE [Montant] > 100")

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Function TS_ImporterDepuisClasseurAvecSQL(ByVal Fichier_Source As String, _
ByVal MotDePasseOuverture As String, _
ByVal MotDePasseEcriture As String, _
ByVal Nom_Tableau_Source As String, _
ByVal TS_Dest As Range, _
ByVal Méthode As Enum_CopierDonnées, _
Optional ByVal StrChamps As String, _
Optional ByVal StrSQL As String = "") As Long
'------------------------------------------------------------------------------------------------------
' Copie en valeur les données d'un tableau, structuré ou non structuré, issues d'un classeur
' Excel (théoriquement fermé) dans un tableau structuré (existant) du classeur contenant ce code,
' suivant une requête SQL. Si le classeur est déjà ouvert il n'est pas refermé à la fin du traitement,
' mais dans ce cas il ne doit pas être en lecture seule.
' Le tableau source doit obligatoirement avoir un en-tête avec des noms de champs uniques pour pouvoir
' exécuter une requête.
' Le classeur n'est ouvert que s'il est protégé par mot de passe (pas d'autre façon de faire) ou si un tableau
' structuré est passé dans le nom du tableau source (afin de retrouver la feuille concernée), mais les macros
' sont désactivées pour ouvrir le fichier sans lancer l'événement "Workbook_Open".
'------------------------------------------------------------------------------------------------------
' Fichier_Source : le classeur Excel qui contient les sources (chemin complet + nom avec l'extension).
' MotDePasseOuverture : éventuellement le mot de passe pour ouvrir le fichier (vide si non nécessaire).
' MotDePasseEcriture : éventuellement le mot de passe pour modifier le fichier (vide si non nécessaire).
' Nom_Tableau_Source : soit le nom du tableau structuré qui contient les données source (pas un Range,
' voir exemple) soit le nom de la feuille entre crochets "[" et "]" (voir exemple).
' TS_Dest : le tableau structuré destination (de type Range) situé sur le classeur contenant cette fonction.
' Méthode : énumération Enum_CopierDonnées =
'   TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
'   TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
' StrChamps : (facultatif) la liste des champs de la requête (ou tous les champs si vide ou non renseigné).
' StrSQL : (facultatif) la requête SQL.
'------------------------------------------------------------------------------------------------------
' Renvoie : le nombre de lignes importées ou -1 si erreur.
'------------------------------------------------------------------------------------------------------
' Remarques :
' - si la source est un tableau structuré alors passez son nom, par exemple "Tableau1" et
' non pas un objet Range comme Range("Tableau1") dans l'argument "Nom_Tableau_Source".
' - Si la source est une plage classique, passez le nom de la feuille sans la plage, comme par
' exemple "[Feuil1]" pour un traitement sur la feuille nommée "Feuil1".
' - La plage doit obligatoirement avoir un en-tête avec des noms de champs uniques pour exécuter une requête.
' - Si le tableau source a plus de colonnes que le tableau destination : les colonnes en surplus sont ignorées.
' - Si le tableau source a moins de colonnes que le tableau destination : les colonnes manquantes sont vides.
'------------------------------------------------------------------------------------------------------
Dim Wk As Workbook
Dim Cnn As Variant, Rs As Variant
Dim Enr As Variant
Dim i As Long, y As Long, x As Integer
Dim Classeurs As String, NomCourt As String
Dim ErreurFeuillle As String
Dim Anc_ScreenUpdating As Boolean
Dim Anc_Cursor As Long
Dim Anc_Attributes As Long

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
Set Wk = Nothing
TS_ImporterDepuisClasseurAvecSQL = -1

' Désactive l'affichage de l'écran:
Anc_Cursor = Application.Cursor
Application.Cursor = xlWait
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' Création d'un objet FileSystemObject:
Dim ObjFSO As Object, ObjFile As Object
Set ObjFile = Nothing
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
' Le fichier ne doit pas être en lecture seule pour pouvoir exécuter une requête SQL:
If ObjFSO.FileExists(Fichier_Source) = True Then
Set ObjFile = ObjFSO.GetFile(Fichier_Source)  ' Pointe sur le fichier.
Anc_Attributes = ObjFile.Attributes           ' Mémorise les attributs.
ObjFile.Attributes = 0                        ' Efface les attributs.
Else
Err.Raise vbObjectError, "TS_ImporterDepuisClasseurAvecSQL", "Le fichier [" & Fichier_Source & "] n'a pas été trouvé."
End If

' Ouvre le classeur source si le mot de passe existe ou si le nom d'un tableau structuré est passé
' en argument, sauf s'il était déjà ouvert:
If MotDePasseOuverture <> "" Or MotDePasseEcriture <> "" Or Left(Nom_Tableau_Source, 1) <> "[" Then
' Mémorise les classeurs ouverts:
For i = 1 To Workbooks.Count
Classeurs = Classeurs & ";" & Workbooks(i).Name & ";"
Next i
' Ouvre le classeur source seulement s'il n'est pas déjà ouvert:
NomCourt = Mid(Fichier_Source, 1 + InStrRev(Fichier_Source, "\"))
If InStr(1, Classeurs, ";" & NomCourt & ";") = 0 Then
' Désactive les macros pour ouvrir le fichier sans lancer "Workbook_Open":
If UCase(Right(Fichier_Source, 5)) <> ".XLSX" Then
Dim secAutomation As MsoAutomationSecurity
secAutomation = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityForceDisable
' Ouvre le fichier:
Set Wk = Workbooks.Open(Fichier_Source, False, False, , MotDePasseOuverture, MotDePasseEcriture, True)
' Réactive les macros:
Application.AutomationSecurity = secAutomation
Else
' Ouvre le fichier:
Set Wk = Workbooks.Open(Fichier_Source, False, False, , MotDePasseOuverture, MotDePasseEcriture, True)
End If
' Récupère la plage si un nom de tableau structuré a été passé en argument:
If Left(Nom_Tableau_Source, 1) <> "[" Then
Range(Nom_Tableau_Source).ListObject.ShowHeaders = True ' Affiche l'en-tête.
Range(Nom_Tableau_Source).ListObject.ShowTotals = False ' Masque les totaux.
Nom_Tableau_Source = Range(Nom_Tableau_Source).Parent.Name ' Récupère la feuille.
End If
Else ' Si le classeur était déjà ouvert il faut l'activer pour récupérer l'adresse du tableau structuré:
If Application.Workbooks(NomCourt).ReadOnly = True Then
Err.Raise vbObjectError, "TS_ImporterDepuisClasseurAvecSQL", "Le classeur " & NomCourt & " ne doit pas être en lecture seule " _
& "s'il est déjà ouvert pour pouvoir faire une requête SQL."
End If
Application.Workbooks(NomCourt).Activate
If Left(Nom_Tableau_Source, 1) <> "[" Then
Range(Nom_Tableau_Source).ListObject.ShowHeaders = True ' Affiche l'en-tête.
Range(Nom_Tableau_Source).ListObject.ShowTotals = False ' Masque les totaux.
Nom_Tableau_Source = Range(Nom_Tableau_Source).Parent.Name ' Récupère la feuille.
End If
End If
End If

' Supprime les crochets dans le nom du tableau source (pas besoin de ces crochets pour la suite):
Nom_Tableau_Source = Replace(Nom_Tableau_Source, "[", "")
Nom_Tableau_Source = Replace(Nom_Tableau_Source, "]", "")
Nom_Tableau_Source = "[" & Nom_Tableau_Source & "$]"

' Création d'une connexion:
Set Cnn = CreateObject("ADODB.Connection") ' Liaison anticipée => Set Cnn = New ADODB.Connection
Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & Fichier_Source & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1;Readonly=False"";"

' Lecture du schéma pour vérifier que la feuille existe:
' voir https://www.w3schools.com/asp/met_conn_openschema.asp
Dim RstSchema, Ok As Boolean
Set RstSchema = Cnn.OpenSchema(20)
Do Until RstSchema.EOF
If "[" & RstSchema!TABLE_NAME & "]" = Nom_Tableau_Source Then Ok = True: Exit Do
RstSchema.MoveNext
Loop
RstSchema.Close

' Si la feuille n'existe pas alors le signaler (ne pas générer d'erreur car parfois la feuille n'est pas reconnue dans le schéma):
If Ok = False Then ErreurFeuillle = "La feuille " & Nom_Tableau_Source & " n'existe pas dans le fichier [" & Fichier_Source & "]."

' Exécute une requête SQL sur un jeu d'enregistrements de la feuille:
Set Rs = CreateObject("ADODB.Recordset") ' Liaison anticipée => Set Rs = New ADODB.Recordset
Rs.Open "SELECT " & IIf(StrChamps <> "", StrChamps, "*") & " FROM " & Nom_Tableau_Source & " " & StrSQL, Cnn, 1, 2, 1 ' Liaison anticipée => adOpenKeyset, adLockPessimistic, adCmdText

' S'il y a des enregistrements concernés alors les copier dans le tableau structuré destination:
If Rs.EOF = False Then
TS_ImporterDepuisClasseurAvecSQL = TS_CopierUnTableau(Rs, TS_Dest, Méthode, TS_Valeurs)
Else
TS_ImporterDepuisClasseurAvecSQL = 0
End If

' Ferme la connexion:
Cnn.Close

' Fin du traitement:
Gest_Err:

' Ferme le lien:
Set Cnn = Nothing

' Fermeture du classeur:
If Not Wk Is Nothing Then
Wk.Saved = True
Wk.Close False
Set Wk = Nothing
End If
ThisWorkbook.Activate

' Restaure les attributs:
If Not ObjFile Is Nothing Then
Set ObjFile = ObjFSO.GetFile(Fichier_Source)  ' Pointe sur le fichier.
ObjFile.Attributes = Anc_Attributes           ' Restaure les attributs.
End If

' Restaure l'affichage d'origine:
Application.ScreenUpdating = Anc_ScreenUpdating
Application.Cursor = Anc_Cursor

' Gestion des erreurs:
If Err.Number = -2147217904 Then Err.Clear ' pas de donnée.
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If ErreurFeuillle <> "" Then TS_Err_Description = ErreurFeuillle
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ImporterDepuisClasseurAvecSQL", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ImporterDepuisClasseurAvecSQL"
End If
Err.Clear

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

VI-O - TS_ImporterFichierTexteAvecSQL

La fonction TS_ImporterFichierTexteAvecSQL importe, dans un tableau structuré existant, les données d'un fichier texte dont les champs sont délimités par un caractère particulier, généralement point-virgule, suivant éventuellement une requête SQL.
Les données sources doivent impérativement avoir un en-tête avec des noms de champs uniques pour pouvoir exécuter une requête.

Ses arguments sont :

- Fichier_Source : le fichier texte qui contient les sources (chemin complet + nom avec l'extension) ;

- Délimiteur : le caractère délimiteur des champs ;

- AvecEntête : Indique si le fichier source à un en-tête (True) ou non (False) ;

- ListeColonnes : le format des colonnes à analyser (ou vide pour tout reprendre au format général) séparés par une virgule. Si la liste ne reprend pas toutes les colonnes, les colonnes non renseignées ne sont pas traitées.
Liste des formats disponibles (vous pouvez en créer d'autres) :
1 = Général (xlGeneralFormat) (les numériques de plus de 15 caractères sont tronqués et ceux avec une virgule sont considérés comme du texte),
2 = Force le texte en le préfixant par " ' ",
3 = Format de date M/J/A (xlMDYFormat),
4 = Format de date J/M/A (xlDMYFormat),
5 = Format de date A/M/J (xlYMDFormat),
6 = Format de date M/A/J (xlMYDFormat),
7 = Format de date J/A/M (xlDYMFormat),
8 = Format de date A/J/M (xlYDMFormat),
9 = La colonne n'est pas analysée (xlSkipColumn),
10 = Numérique,
11 = Numérique arrondis à 2 chiffres après la virgule,
12 = Texte sans les espaces de gauche,
13 = Texte sans les espaces de droite,
14 = Texte sans les espaces de gauche et de droite,
15 = Format JJMMAAAA transformé en date,
16 = Format AAAAMMJJ transformé en date ;

- TS_Dest : le tableau structuré destination (de type Range) situé dans le classeur contenant cette fonction ;

- Méthode : indique si les données importées doivent remplacer celles existantes dans le tableau structuré ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes ;

- StrSQL : (facultatif) la requête SQL, basée sur le nom des colonnes du tableau structuré destination et non pas sur les noms des champs du fichier texte.

La fonction renvoie : le nombre de lignes importées ou -1 si erreur.

Remarques :

- si le fichier texte a plus de colonnes que le tableau destination : les colonnes en surplus sont ignorées ;

- si le fichier texte a moins de colonnes que le tableau destination : les colonnes manquantes sont vides.

Exemples pour importer dans le tableau structuré destination nommé « TS_1 » ce fichier texte nommé « Eleves.csv » qui a comme délimiteur un point-virgule :

Pour importer tous les champs avec le format par défaut (format général) :

Call TS_ImporterFichierTexteAvecSQL("C:\_Formation_VBA\Eleves.csv", ";", True, _
"", _
Range("TS_1"), TS_RemplacerDonnées)

Ce qui donne ce résultat (les notes avec une virgule sont considérées comme étant du texte, le numéro de dossier est tronqué) :

Pour importer tous les champs avec format numérique pour les notes, format date pour les dates, format texte pour les dossiers :

Call TS_ImporterFichierTexteAvecSQL("C:\_Formation_VBA\Eleves.csv", ";", True, _
"1, 1, 10, 4, 1, 1, 1, 1, 2", _
Range("TS_1"), TS_RemplacerDonnées)

Call TS_FormatColonne(Range("TS_1"), "Note", "0.0")
Call TS_FormatColonne(Range("TS_1"), "Date", "dd/mm/yyyy")

Ce qui donne ce résultat :

Pour importer uniquement des champs Nom, Prénom, Note, Souhaits, pour les notes supérieures à 10 et les trier par nom :

Call TS_ImporterFichierTexteAvecSQL("C:\_Formation_VBA\Eleves.csv", ";", True, _
"1, 1, 10, 9, 9, 9, 1", _
Range("TS_1"), TS_RemplacerDonnées, _
"WHERE [Note] > 10 ORDER BY [Nom]")

Ce qui donne ce résultat :

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Function TS_ImporterFichierTexteAvecSQL(ByVal Fichier_Source As String, _
ByVal Délimiteur As String, _
ByVal AvecEntête As Boolean, _
ByVal ListeColonnes As String, _
ByVal TS_Dest As Range, _
ByVal Méthode As Enum_CopierDonnées, _
Optional ByVal StrSQL As String = "") As Long
'------------------------------------------------------------------------------------------------------
' Copie en valeur les données d'un fichier texte dont les champs sont délimités par un caractère particulier,
' généralement point-virgule, suivant éventuellement une requête SQL.
'------------------------------------------------------------------------------------------------------
' Fichier_Source : le fichier texte qui contient les sources (chemin complet + nom avec l'extension).
' Délimiteur : le délimiteur des champs.
' AvecEntête : Indique si le fichier source à un en-tête (True) ou non (False).
' ListeColonnes : le format des colonnes à analyser (ou vide pour tout reprendre au format général) séparés
'                 par une virgule. Si la liste ne reprend pas toutes les colonnes, les colonnes non renseignées
'                 ne sont pas traitées.
' Liste des formats disponibles (vous pouvez en créer d'autres):
' 1  = Général (xlGeneralFormat) (les numériques de plus de 15 caractères sont tronqués et
'      ceux avec une virgule sont considérés comme du texte).
' 2  = Force le Texte en le préfixant par "'".
' 3  = Format de date M/J/A (xlMDYFormat).
' 4  = Format de date J/M/A (xlDMYFormat).
' 5  = Format de date A/M/J (xlYMDFormat).
' 6  = Format de date M/A/J (xlMYDFormat).
' 7  = Format de date J/A/M (xlDYMFormat).
' 8  = Format de date A/J/M (xlYDMFormat).
' 9  = La colonne n'est pas analysée (xlSkipColumn).
' 10 = Numérique.
' 11 = Numérique arrondis à 2 chiffres après la virgule.
' 12 = Texte sans les espaces de gauche.
' 13 = Texte sans les espaces de droite.
' 14 = Texte sans les espaces de gauche et de droite.
' 15 = Format JJMMAAAA transformé en date.
' 16 = Format AAAAMMJJ transformé en date.
' TS_Dest : le tableau structuré destination (de type Range) situé sur le classeur contenant cette fonction.
' Méthode : énumération Enum_CopierDonnées =
'   TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
'   TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
' StrSQL : (facultatif) la requête SQL, basée sur le nom des colonnes du tableau structuré destination et
' non pas sur les noms des champs du fichier texte.
'------------------------------------------------------------------------------------------------------
' Renvoie : le nombre de lignes importées ou -1 si erreur.
'------------------------------------------------------------------------------------------------------
' Remarques :
' - Si le fichier texte a plus de colonnes que le tableau destination : les colonnes en surplus sont ignorées.
' - Si le fichier texte a moins de colonnes que le tableau destination : les colonnes manquantes sont vides.
'------------------------------------------------------------------------------------------------------
Dim FormatColonne As Variant
Dim Ligne As String
Dim NumFichier As Long
Dim Lu As Long, Taille As Long
Dim NbLignes As Long
Dim y As Long, x As Integer, NbCol As Integer
Dim V, T, Lecture()
Dim NumCol As Integer, Mt As Double
Dim Anc_Cursor As Long, Anc_ScreenUpdating As Boolean

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

' Désactive l'affiche écran:
Anc_Cursor = Application.Cursor
Application.Cursor = xlWait
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' Lecture du fichier et mémorisation des données:
NumFichier = FreeFile
Taille = FileLen(Fichier_Source)
Application.StatusBar = "Lecture du fichier : " & Fichier_Source
Open Fichier_Source For Input As #NumFichier

' Saute l'en-tête:
If AvecEntête = True Then Line Input #NumFichier, Ligne

' Boucle sur les lignes du fichier:
Do While Not EOF(NumFichier)
Line Input #NumFichier, Ligne
' Compte le nombre d'octets lus et le nombre de lignes:
Lu = Lu + Len(Ligne) + 2
NbLignes = NbLignes + 1
' Mémorise la ligne lue:
ReDim Preserve Lecture(1 To NbLignes)
Lecture(NbLignes) = Ligne
' Affiche la progression de la lecture:
If NbLignes Mod 1000 = 0 Then
Application.StatusBar = "Lecture du fichier : " & Format(Lu / Taille, "0%")
DoEvents
End If
Loop

' Ferme le fichier:
Close #NumFichier

' Analyse du format des colonnes à traiter:
V = Split(Lecture(1), Délimiteur)                ' Compte le nombre de colonnes dans la source.
ListeColonnes = Replace(ListeColonnes, " ", "")  ' Suppression des espaces dans la liste des colonnes demandées.
ListeColonnes = Replace(ListeColonnes, ";", ",") ' Remplacement du séparateur.
' Si rien n'est renseigné alors par défaut prendre toutes les colonnes:
If ListeColonnes = "" Then ListeColonnes = String(UBound(V) + 1, "x"): ListeColonnes = Replace(ListeColonnes, "x", "1,")
If Right(ListeColonnes, 1) = "," Then ListeColonnes = Left(ListeColonnes, Len(ListeColonnes) - 1)
ListeColonnes = "x," & ListeColonnes
FormatColonne = Split(ListeColonnes, ",")

' Compte le nombre de colonnes qu'il faudra traiter:
For x = 1 To UBound(FormatColonne)
If FormatColonne(x) <> 9 Then NbCol = NbCol + 1
Next x

' Traitement des colonnes:
ReDim Données(1 To NbLignes, 1 To NbCol)
Application.StatusBar = "Correction des données..."
' Boucle sur les lignes à traiter:
For y = 1 To NbLignes
' Affiche la progression de temps en temps:
If y Mod 1000 = 0 Then
Application.StatusBar = "Correction des données : " & Format(Lu / Taille, "0%")
DoEvents
End If
' Lecture de la ligne et la découpe avec le délimiteur:
V = Split(Lecture(y), Délimiteur)
' Boucle sur les colonnes:
NumCol = 0
For x = 1 To UBound(FormatColonne)
' Si la colonne est à traiter:
If FormatColonne(x) <> 9 Then
NumCol = NumCol + 1
' Si la donnée n'est pas vide:
If V(x - 1) <> "" Then
' Suivant le format de l'entrée:
Select Case FormatColonne(x)
Case 1:
Case 2: V(x - 1) = "'" & V(x - 1)
Case 3: T = Split(V(x - 1), "/"): V(x - 1) = Format(DateValue(DateSerial(T(2), T(0), T(1))), 0)
Case 4: T = Split(V(x - 1), "/"): V(x - 1) = Format(DateValue(DateSerial(T(2), T(1), T(0))), 0)
Case 5: T = Split(V(x - 1), "/"): V(x - 1) = Format(DateValue(DateSerial(T(0), T(1), T(2))), 0)
Case 6: T = Split(V(x - 1), "/"): V(x - 1) = Format(DateValue(DateSerial(T(2), T(0), T(1))), 0)
Case 7: T = Split(V(x - 1), "/"): V(x - 1) = Format(DateValue(DateSerial(T(1), T(2), T(0))), 0)
Case 8: T = Split(V(x - 1), "/"): V(x - 1) = Format(DateValue(DateSerial(T(0), T(2), T(1))), 0)
Case 10, 11:
V(x - 1) = Replace(V(x - 1), " ", "")
V(x - 1) = Replace(V(x - 1), ",", ".")
If V(x - 1) <> "" Then
While Not Right(V(x - 1), 1) Like "[0-9%]" And Len(V(x - 1)) > 0
V(x - 1) = Left(V(x - 1), Len(V(x - 1)) - 1)
Wend
End If
If FormatColonne(x) = 11 Then
If V(x - 1) <> "" And Right(V(x - 1), 1) <> "%" Then V(x - 1) = Replace(Round(Val(V(x - 1)), 2), ",", ".")
End If
Case 12: V(x - 1) = LTrim(V(x - 1))
Case 13: V(x - 1) = RTrim(V(x - 1))
Case 14: V(x - 1) = Trim(V(x - 1))
Case 15: V(x - 1) = Format(DateValue(DateSerial(Right(V(x - 1), 4), Mid(V(x - 1), 3, 2), Left(V(x - 1), 2))), 0)
Case 16: V(x - 1) = Format(DateValue(DateSerial(Left(V(x - 1), 4), Mid(V(x - 1), 5, 2), Right(V(x - 1), 2))), 0)
End Select
End If
' Mémorise la donnée:
Données(y, NumCol) = V(x - 1)
End If
Next x
Next y

' Alimentation du tableau structuré destination:
Application.StatusBar = ""

' Si c'est une requête pour ajouter des données du fichier texte à celles existantes:
If Méthode = TS_AjouterDonnées And StrSQL <> "" Then
Dim Copie1, Copie2
' Mémorise les données existantes:
Copie1 = TS_MémoriseTableau(TS_Dest, TS_Valeurs)
' Les remplace par les données du fichier texte:
Call TS_CopierUnTableau(Données, TS_Dest, TS_RemplacerDonnées, TS_Valeurs)
' Exécute une requête sur le données du tableau ainsi obtenu:
Call TS_RequeteSQL(TS_Dest, "", StrSQL, TS_Dest, TS_RemplacerDonnées)
' Mémorise le résultat de la requête:
Copie2 = TS_MémoriseTableau(TS_Dest, TS_Valeurs)
' Efface le tableau et restitue les données d'origine:
Call TS_CopierUnTableau(Copie1, TS_Dest, TS_RemplacerDonnées, TS_Valeurs)
' Leur ajoute le résultat de la requête:
TS_ImporterFichierTexteAvecSQL = TS_CopierUnTableau(Copie2, TS_Dest, TS_AjouterDonnées, TS_Valeurs)
Else
' Remplace les données existantes par les données du fichier texte:
TS_ImporterFichierTexteAvecSQL = TS_CopierUnTableau(Données, TS_Dest, Méthode, TS_Valeurs)
' Si une requête est renseignée alors l'applique:
If StrSQL <> "" Then TS_ImporterFichierTexteAvecSQL = TS_RequeteSQL(TS_Dest, "", StrSQL, TS_Dest, Méthode)
End If

' Gestion des erreurs:
Gest_Err:
Application.StatusBar = ""
Application.Cursor = Anc_Cursor
Application.ScreenUpdating = Anc_ScreenUpdating
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ImporterFichierTexteAvecSQL", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ImporterFichierTexteAvecSQL"
End If
Err.Clear

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

VI-P - TS_ImporterDepuisFichierHTML

La fonction TS_ImporterDepuisFichierHTML importe dans un tableau structuré existant les données d'un fichier au format HTML qui contient un tableau.
Si le tableau structuré n'a pas assez de colonnes, celles nécessaires seront créées automatiquement.
Les données importées sont soit ajoutées aux données existantes du tableau structuré soit les remplacent.
Le code est inspiré de cette discussion.

Ses arguments sont :

- TS : la plage (de type Range) du tableau structuré ;

- Fichier : le fichier HTML qui contient un tableau (chemin complet + nom avec l'extension) ;

- Méthode : indique si les données importées doivent remplacer celles existantes dans le tableau structuré ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.

La fonction renvoie : le nombre de lignes importées ou -1 en cas d'erreur.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ImporterDepuisFichierHTML(TS As Range, Fichier As String, _
Méthode As Enum_CopierDonnées) As Long
'-----------------------------------------------------------------------------------------------
' Importe une table d'un fichier au format HTML.
' Les données sont recopiées dans le tableau structuré en remplacement des données existantes ou ajoutées.
' Sources:
' https://www.developpez.net/forums/d2150324/logiciels/microsoft-office/excel/macros-vba-excel/import-html-convertion-utf
'-----------------------------------------------------------------------------------------------
' TS : le tableau structuré où importer les données issues d'Access.
'      S'il n'y pas assez de colonnes dans le tableau elles sont ajoutées.
' Fichier : le fichier HTML qui contient un tableau (chemin complet + nom avec l'extension).
' Méthode : énumération Enum_CopierDonnées =
'           TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
'           TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
'-----------------------------------------------------------------------------------------------
' Renvoie : le nombre de lignes importées ou -1 en cas d'erreur.
'-----------------------------------------------------------------------------------------------
Dim i As Long, j As Long
Dim oDoc  As Object, HTMLTable As Object
Dim TableRow As Object, TableCell As Object, Donnee As Object
Dim NbOrigine As Long

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

' Par défaut renvoie -1:
TS_ImporterDepuisFichierHTML = -1

' Mémorise la présentation:
Dim Anc_Screen As Boolean
Anc_Screen = Application.ScreenUpdating
Application.ScreenUpdating = False
Dim Anc_Cursor As Long
Anc_Cursor = Application.Cursor
Application.Cursor = xlWait

' Bloque les calculs:
Dim AncCalculation
AncCalculation = Application.Calculation
Application.Calculation = xlCalculationManual

' Charge le fichier HTML:
Set oDoc = CreateObject("HtmlFile")
With CreateObject("ADODB.Stream")
.Open
.Type = 1 ' 1=adTypeBinary
.LoadFromFile Fichier
.Type = 2 ' 2=adTypeText
.Charset = "utf-8"
oDoc.body.innerHTML = .ReadText(-1) ' -1=adReadAll
.Close
End With

' Recherche une structure de type tableau et quitte si aucun tableau trouvé:
Set HTMLTable = oDoc.getElementsByTagName("table")(0)
If HTMLTable Is Nothing Then GoTo Gest_Err

' S'il faut remplacer ou ajouter les données:
Select Case Méthode
Case TS_RemplacerDonnées
Call TS_EffacerToutesLignes(TS)
Call TS_SupprimerPlusieursLignes(TS, 2, 0)
i = 1
Case TS_AjouterDonnées
NbOrigine = TS_Nombre_Lignes(TS)
i = NbOrigine + 1
End Select

' Boucle sur les éléments du tableau:
For Each TableRow In HTMLTable.getElementsByTagName("tr")
' Si la ligne contient un tableau:
If TableRow.getElementsByTagName("td").Length > 0 Then
' Boucle sur chaque colonne du tableau:
Set TableCell = TableRow.getElementsByTagName("td")
j = 1
For Each Donnee In TableCell
' Ajout d'un colonne s'il n'y en a pas assez dans le tableau structuré:
If j > TS_Nombre_Colonnes(TS) Then Call TS_AjouterUneColonne(TS, 0, "")
' Pose la données dans le tableau structuré:
TS.ListObject.DataBodyRange(i, j).Value = Donnee.innerText
j = j + 1
Next
i = i + 1
End If
Next

' Renvoie le nombre de lignes ajoutées:
TS_ImporterDepuisFichierHTML = TS_Nombre_Lignes(TS) - NbOrigine

' Fin du traitement:
Gest_Err:
' Restaure la présentation:
Application.Calculation = AncCalculation
Application.ScreenUpdating = Anc_Screen
Application.Cursor = Anc_Cursor
' Erreurs:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ImporterDepuisFichierHTML", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ImporterDepuisFichierHTML"
End If
Err.Clear

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

VII - Vos contributions

Ce chapitre reprend les fonctions qui m'ont été proposées ou que certaines discussions m'ont inspiré.

VII-A - TS_CelluleActive

La fonction TS_CelluleActive indique si la cellule active est dans le tableau structuré passé en argument. Si c'est le cas alors elle renseigne les variables « Colonne » et « Ligne » des coordonnées de la cellule dans le tableau et renvoie la cellule active.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : si la cellule active est dans le tableau, cette variable contiendra le numéro de la colonne ;

- Ligne : si la cellule active est dans le tableau, cette variable contiendra le numéro de la ligne.

La fonction renvoie : la cellule active (la première si c'est une plage de plusieurs cellules, ou Nothing si la cellule active n'est pas dans le tableau structuré (ou si une erreur s'est produite).

Exemple d'utilisation pour savoir si la cellule active est à l'intérieur du tableau structuré « TS_Eleves » et si c'est le cas pour afficher dans la fenêtre d'exécution sa position et sa valeur :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim r As Range, Colonne As Long, Ligne As Long
Set r = TS_CelluleActive(Range("TS_Eleves"), Colonne, Ligne)
If Not r Is Nothing Then Debug.Print Colonne, Ligne, r.Value
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_CelluleActive(TS As Range, ByRef Colonne As Long, ByRef Ligne As Long) As Range
'------------------------------------------------------------------------------------------------
' Indique si la cellule active est dans le Tableau Structuré passé en argument.
' Si c'est le cas alors elle renseigne "Colonne" et "Ligne" des coordonnées de la cellule dans le tableau
' et renvoie la cellule active.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Si la cellule active est dans le tableau, contiendra le numéro de la colonne.
' Ligne : Si la cellule active est dans le tableau, contiendra le numéro de la ligne.
'------------------------------------------------------------------------------------------------
' Renvoie : La cellule active (la première si c'est une plage de plusieurs cellules,
'           ou Nothing si la cellule active n'est pas dans le tableau structuré (ou erreur).
'------------------------------------------------------------------------------------------------
' Renseigne : Colonne et Ligne (voir ci-dessus).
'------------------------------------------------------------------------------------------------
Dim r As Range, x As Long, y As Long

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

' Si la cellule active est dans le tableau structuré:
If TS.ListObject.Active = True Then
Set r = ActiveCell
y = r.Row - TS.Row + 1
x = r.Column - TS.Column + 1
' Si elle est à l'intérieur du tableau (hors en-têtes et totaux):
If y <= TS.Rows.Count And y > 0 Then
Colonne = x
Ligne = y
Set TS_CelluleActive = r
End If
End If

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_CelluleActive", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_CelluleActive"
End If
Err.Clear

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

VII-B - TS_ObjetInserer

La fonction TS_ObjetInserer insère un objet dans une cellule du tableau structuré passé en argument. Un objet peut être une image (cas classique) mais aussi tout autre type de fichier supporté par votre version d'Excel, tels que les fichiers au format PDF, les fichiers son, les fichiers texte, les classeurs Excel...
Un double-clic (ou un clic droit) sur l'objet l'ouvre (testé sur les versions 2016 et 365).

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou 0, alors la dernière colonne du tableau est traitée ;

- Ligne : la ligne concernée. Si 0 est renseigné alors prend la dernière ligne ;

- Fichier : le nom complet du fichier (avec son chemin) ;

- Nom : le nom à donner à l'objet (laissez à vide pour garder le nom attribué automatiquement par Excel), plusieurs objets peuvent avoir le même nom ;

- LargeurObjet : la largeur de l'objet, laissez à 0 pour prendre la largeur par défaut (le ratio est conservé) ;

- HauteurObjet : la hauteur de l'objet, laissez à 0 pour prendre la hauteur par défaut (le ratio est conservé).

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

remarques :

- si la feuille n'est pas protégée l'utilisateur peut déplacer l'objet (voire le supprimer) et les objets ne sont pas masqués sur les cellules filtrées ;

- l'incorporation des objets fait gonfler la taille du classeur.

Cette technologie est donc à utiliser avec modération.
Suivant votre situation, pensez à l'alternative qui consiste à insérer un lien hypertexte dans la cellule ou une image dans le commentaire, voir la fonction TS_ModifCellule.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ObjetInserer(TS As Range, _
ByVal Colonne As Variant, _
ByVal Ligne As Long, _
ByVal Fichier As Variant, _
Optional ByVal Nom As String = "", _
Optional LargeurObjet As Long = 0, _
Optional HauteurObjet As Long = 0) As Boolean
'------------------------------------------------------------------------------------------------
' Insère un objet dans une cellule.
' L'objet peut être une image, un fichier texte, un classeur Excel...
' Plusieurs objets peuvent avoir le même nom.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Ligne : La ligne concernée.
'         Si 0 alors prend la dernière ligne du Tableau Structuré.
' Fichier : Le nom complet du fichier (avec son chemin).
' Nom : Le nom à appliquer à l'objet (s'il est renseigné).
' LargeurObjet : Largeur de l'objet, ou 0 pour la taille par défaut.
' HauteurObjet : Hauteur de l'objet, ou 0 pour la taille par défaut.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim Shp As Shape

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

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Contrôle la cohérence de la ligne passée en argument:
If Ligne >= 0 Then
Ligne = TS_IndexLigne(TS, Ligne)
If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
End If

' Supprime l'éventuel objet existant dans la cellule:
For Each Shp In Sheets(TS.Parent.Name).Shapes
If (Abs(Shp.Left - TS.ListObject.DataBodyRange(Ligne, Colonne).Left) < 2 _
And Abs(Shp.Top - TS.ListObject.DataBodyRange(Ligne, Colonne).Top) < 2) _
Then
Shp.Delete
End If
Next Shp

' Pose l'objet dans la cellule et définit son nom (plusieurs objets peuvent avoir le même nom):
With Sheets(TS.Parent.Name).OLEObjects.Add(Filename:=Fichier)
.Left = TS.ListObject.DataBodyRange(Ligne, Colonne).Left
.Top = TS.ListObject.DataBodyRange(Ligne, Colonne).Top
.Width = IIf(LargeurObjet > 0, LargeurObjet, TS.ListObject.DataBodyRange(Ligne, Colonne).Width)
.Height = IIf(HauteurObjet > 0, HauteurObjet, TS.ListObject.DataBodyRange(Ligne, Colonne).Height)
On Error Resume Next
If Nom <> "" Then .Name = Nom   ' Ne marche pas sur les fichiers PDF
Err.Clear
End With

' Si la hauteur et la largeur sont indiquées il ne faut pas respecter le ratio d'origine:
If LargeurObjet > 0 And HauteurObjet > 0 Then
Dim i As Integer
i = Sheets(TS.Parent.Name).Shapes.Count
Sheets(TS.Parent.Name).Shapes(i).LockAspectRatio = msoFalse
Sheets(TS.Parent.Name).Shapes(i).Width = LargeurObjet
Sheets(TS.Parent.Name).Shapes(i).Height = HauteurObjet
End If

' Renvoie VRAI:
TS_ObjetInserer = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ObjetInserer", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ObjetInserer"
End If
Err.Clear

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

VII-C - TS_ObjetSupprimer

La fonction TS_ObjetSupprimer supprime un objet du tableau structuré passé en argument.
En principe l'objet a été inséré par la fonction TS_ObjetInserer.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Nom : le nom de l'objet (laissez à vide pour supprimer tous les objets de la feuille), plusieurs objets peuvent avoir le même nom.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ObjetSupprimer(TS As Range, _
Nom As String) As Boolean
'------------------------------------------------------------------------------------------------
' Supprime les objets du nom passé en argument.
' Plusieurs objets peuvent avoir le même nom.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Nom : Le nom de l'objet. Si non renseigné alors supprime tous les objets de la feuille.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim Shp As Shape

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

' Supprime l'objet si le nom est renseigné ou tous les objets de la feuille si
' le nom n'est pas renseigné:
For Each Shp In Sheets(TS.Parent.Name).Shapes
If Shp.Name = Nom Or Nom = "" Then
Shp.Delete
End If
Next Shp

' Renvoie VRAI:
TS_ObjetSupprimer = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ObjetSupprimer", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ObjetSupprimer"
End If
Err.Clear

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

VII-D - TS_ObjetNom

La fonction TS_ObjetNom revoie le nom de l'objet contenu dans une cellule du tableau structuré passé en argument.
En principe l'objet a été inséré par la fonction TS_ObjetInserer.
L'objet ne doit pas avoir été déplacé par l'utilisateur pour pouvoir être retrouvé par cette fonction.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le numéro de la colonne, ou le nom de la colonne. Si 0 est renseigné alors prend la dernière colonne ;

- Ligne : la ligne concernée. Si 0 est renseigné alors prend la dernière ligne.

La fonction renvoie : le nom de l'objet de la cellule s'il est trouvé ou vide.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ObjetNom(TS As Range, _
ByVal Colonne As Variant, _
ByVal Ligne As Long) As String
'------------------------------------------------------------------------------------------------
' Renvoie le nom de l'objet d'une une cellule.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Ligne : La ligne concernée.
'         Si 0 alors prend la dernière ligne du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : le nom de l'objet de la cellule s'il est trouvé ou vide.
'------------------------------------------------------------------------------------------------
Dim Shp As Shape

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

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Contrôle la cohérence de la ligne passée en argument:
If Ligne >= 0 Then
Ligne = TS_IndexLigne(TS, Ligne)
If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
End If

' Boucle sur les objet de la feuille pour retrouver celui aux coordonnées passées:
For Each Shp In Sheets(TS.Parent.Name).Shapes
If (Abs(Shp.Left - TS.ListObject.DataBodyRange(Ligne, Colonne).Left) < 2 _
And Abs(Shp.Top - TS.ListObject.DataBodyRange(Ligne, Colonne).Top) < 2) _
Then
TS_ObjetNom = Shp.Name
Exit For
End If
Next Shp

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ObjetNom", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ObjetNom"
End If
Err.Clear

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

VII-E - TS_ObjetRenommer

La fonction TS_ObjetRenommer renomme un objet du tableau structuré passé en argument.
En principe l'objet a été inséré par la fonction TS_ObjetInserer.
Si plusieurs objets ont le même nom tous sont renommés.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- AncienNom : le nom de l'objet qu'il faut renommer ;

- NouveauNom : le nouveau nom de l'objet.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ObjetRenommer(TS As Range, _
AncienNom As String, _
NouveauNom As String) As Boolean
'------------------------------------------------------------------------------------------------
' Renomme un objet.
' Plusieurs objets peuvent avoir le même nom.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' AncienNom : Le nom de l'objet qu'il faut renommer.
' NouveauNom : Le nouveau nom de l'objet.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim Shp As Shape

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

' Boucle sur les objets de la feuille (plusieurs objets peuvent avoir le même nom):
For Each Shp In Sheets(TS.Parent.Name).Shapes
If Shp.Name = AncienNom Then Shp.Name = NouveauNom
Next Shp

' Renvoie VRAI:
TS_ObjetRenommer = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ObjetRenommer", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ObjetRenommer"
End If
Err.Clear

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

VII-F - TS_ModifierListeValidation

La fonction TS_ModifierListeValidation met à jour une liste de validation dont la source est une colonne d'un tableau structuré.
Une alternative est de renseigner =INDIRECT("Tableau[Colonne]" dans la source des données de validation où "Tableau" est le nom du tableau structuré et "Colonne" le nom de la colonne. Ce qui met à jour automatiquement la liste de validation en cas de modification de la source.
Cette fonction permet de référencer différentes sources à une même liste de validation.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le numéro de la colonne ou le nom de la colonne concernée, ou 0 pour traiter la dernière colonne ;

- Cellule : la cellule (de type Range) qui contient la liste de validation.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ModifierListeValidation(TS As Range, _
ByVal Colonne As Variant, _
ByVal Cellule As Range) As Boolean
'------------------------------------------------------------------------------------------------
' Modifie la liste de validation d'une cellule en prenant la colonne d'un tableau structuré
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Cellule : La cellule qui contient la liste de validation à modifier.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Exemple pour modifier la liste de validation de la cellule B11 d'après la colonne "Nom" du
' tableau structuré nommé "Tableau1" :
' Call TS_ModifierListeValidation(Range("Tableau1"), "Nom", Range("B11"))
'------------------------------------------------------------------------------------------------
' Autres méthodes:
' https://www.developpez.net/forums/d1902678/logiciels/microsoft-office/excel/contribuez/referencer-colonne-d-tableau-structure-validation-donnees/
' Créer un nom à l'aide du gestionnaire des noms qui fera référence à cette colonne par exemple
' tblArt_ref qui fera référence à T_Article[Ref] et ensuite faire référence à ce nom dans la Validation de données.
' Utiliser la fonction INDIRECT comme ici : =INDIRECT("Tableau1[Nom]")
'------------------------------------------------------------------------------------------------

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

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Modifie la liste pour prendre toutes les données de la colonne passée en argument:
Cellule.Validation.Modify Formula1:="=" & TS.ListObject.Parent.Name & "!" & TS.ListObject.ListColumns(Colonne).DataBodyRange.Address

' Renvoie VRAI:
TS_ModifierListeValidation = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ModifierListeValidation", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ModifierListeValidation"
End If
Err.Clear

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

VII-G - TS_ListeSansDoubon

La fonction TS_ListeSansDoubon renvoie une liste sans doublon (valeur unique) en base 0 de la colonne d'un tableau structuré, classée par ordre croissant.
La fonction utilise une requête SQL mais nous verrons avec TS_ValeurUnique une autre façon de faire, plus rapide en temps d'exécution mais qui ne prend pas bien en charge les cellules contenant des erreurs.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le numéro de la colonne ou le nom de la colonne concernée, ou 0 pour traiter la dernière colonne.

La fonction renvoie : une mémoire contenant les valeurs uniques où la première valeur est en index 0. Une cellule non renseignée (vide) vaut Null (et pas Empty).

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ListeSansDoubon(TS As Range, ByVal Colonne As Variant) As Variant
'------------------------------------------------------------------------------------------------
' Renvoie une liste sans doublon (valeur unique) en base 0 de la colonne d'un tableau structuré,
' classée par ordre croissant.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : Une mémoire contenant les valeurs uniques où la première valeur est en index 0
'           Une cellule nom renseignée (vide) vaut Null (et pas Empty).
'------------------------------------------------------------------------------------------------
' Exemple pour obtenir les valeurs uniques d'après la colonne "Prénom" du
' tableau structuré nommé "Tableau1" :
'Dim V As Variant, i As Long
'Call TS_SiErreur(TS_MsgBox_Erreur)
'V = TS_ListeSansDoubon(Range("Tableau1"), "Prénom")
'For i = 0 To UBound(V)
'    Debug.Print V(i)
'Next i
'------------------------------------------------------------------------------------------------
Dim NomColonne As String, StrSQL As String
Dim i As Long
Dim Rs As Variant, V() As Variant

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

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
' Retrouve le nom de la colonne:
NomColonne = "[" & TS.ListObject.ListColumns(Colonne).Name & "]"

' Requête pour grouper par nom du champ et classer:
Set Rs = TS_RequeteSQL(TS, NomColonne, "GROUP BY " & NomColonne & " ORDER BY " & NomColonne)

' S'il y a des enregistrements concernés alors les renvoie:
If Not Rs Is Nothing Then
ReDim V(0 To Rs.RecordCount - 1)
For i = 0 To Rs.RecordCount - 1
V(i) = Rs.Fields(0)
Rs.MoveNext
Next i
End If

' Renvoi les données sous forme de variable:
TS_ListeSansDoubon = V

' Fin du traitement:
Gest_Err:

' Fin du traitement:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ListeSansDoubon", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ListeSansDoubon"
End If
Err.Clear

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

VII-H - TS_ValeurUnique

La fonction TS_ValeurUnique renvoie une liste sans doublon (valeur unique) en base 0 de la colonne d'un tableau structuré, classée par ordre croissant.
La fonction utilise un l'algorithme de classement rapide QuickSort (un peu moins rapide que QuickRanking mais plus simple à écrire et qui convient ici) pour trier les données. Il suffit ensuite de parcourir cette liste et de ne retenir que les éléments différents du suivant pour avoir une liste de valeurs uniques. Ce qui est très rapide en temps d'exécution en VBA.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le numéro de la colonne ou le nom de la colonne concernée, ou 0 pour traiter la dernière colonne.

La fonction renvoie : une mémoire contenant les valeurs uniques où la première valeur est en index 0.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ValeurUnique(TS As Range, ByVal Colonne As Variant) As Variant
'------------------------------------------------------------------------------------------------
' Renvoie une liste sans doublon (valeur unique) en base 0 de la colonne d'un tableau structuré,
' classée par ordre croissant.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : Une mémoire contenant les valeurs uniques où la première valeur est en index 0.
'------------------------------------------------------------------------------------------------
' Exemple pour obtenir les valeurs uniques d'après la colonne "Prénom" du
' tableau structuré nommé "Tableau1" :
'Dim V As Variant, i As Long
'V = TS_ValeurUnique(Range("Tableau1"), "Prénom")
'For i = 0 To UBound(V)
'    Debug.Print V(i)
'Next i
'------------------------------------------------------------------------------------------------
Dim NomColonne As String, StrSQL As String
Dim i As Long, k As Long
Dim X() As Variant, V() As Variant

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

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Charge les données de la colonne:
X = TS.ListObject.ListColumns(Colonne).DataBodyRange.Value

' Trie les données (en base 1):
Call TS_QuickSort(X(), 1, UBound(X))

' Renvoie les données sans doublon:
ReDim V(0 To UBound(X))
V(0) = X(1, 1)
For i = 1 To UBound(X)
If X(i, 1) <> V(k) Then k = k + 1: V(k) = X(i, 1):
Next i
ReDim Preserve V(0 To k)

' Renvoie les données sous forme de variable:
TS_ValeurUnique = V

' Fin du traitement:
Gest_Err:

' Fin du traitement:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ValeurUnique", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ValeurUnique"
End If
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Private Sub TS_QuickSort(ByRef TabDonnées() As Variant, ByVal Gauche As Long, ByVal Droite As Long)
'----------------------------------------------------------------------------------------
' Algorithme QuickSort optimisé pour trier une colonne d'un tableau structuré.
'----------------------------------------------------------------------------------------
Dim i As Long, j As Long, Temp As Variant, Pivot As Variant

i = Gauche
j = Droite
Pivot = TabDonnées((Gauche + Droite) / 2, 1)

Do
While Pivot > TabDonnées(i, 1): i = i + 1: Wend
While TabDonnées(j, 1) > Pivot: j = j - 1: Wend

If j + 1 > i Then
Temp = TabDonnées(i, 1)
TabDonnées(i, 1) = TabDonnées(j, 1)
TabDonnées(j, 1) = Temp
If LBound(TabDonnées, 2) = 0 Then
Temp = TabDonnées(i, 0)
TabDonnées(i, 0) = TabDonnées(j, 0)
TabDonnées(j, 0) = Temp
End If
j = j - 1: i = i + 1
End If

Loop Until i > j

If Gauche < j Then Call TS_QuickSort(TabDonnées(), Gauche, j)
If i < Droite Then Call TS_QuickSort(TabDonnées(), i, Droite)

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

VII-I - TS_ComparerDeuxTableaux

La fonction TS_ComparerDeuxTableaux compare les données de deux colonnes de deux tableaux structurés et renvoie les données identiques ou différentes (suivant la méthode de comparaison désirée) soit dans une variable soit dans un tableau.

La fonction utilise TS_ValeurUnique pour obtenir des listes de données uniques et triées puis fait une recherche dichotomique sur les éléments, ce qui est bien plus rapide qu'un traitement par la force brute ou l'utilisation de Application.Match (Find est beaucoup plus lent mais permet de respecter la casse si besoin).

Ses arguments sont :

- TS_1 : la plage (de type Range) qui représente le premier tableau structuré ;

- Colonne_1 : le numéro de la colonne ou le nom de la colonne concernée dans le premier tableau structuré, ou 0 pour traiter la dernière colonne ;

- TS_2 : la plage (de type Range) qui représente le deuxième tableau structuré ;

- Colonne_2 : le numéro de la colonne ou le nom de la colonne concernée dans le deuxième tableau structuré, ou 0 pour traiter la dernière colonne ;

- Méthode : la méthode de comparaison
0 = renvoie les données que l'on retrouve dans TS_1 et dans TS_2,
-1 = renvoie les données de TS_1 que l'on ne retrouve pas dans TS_2,
1 = renvoie les données de TS_2 que l'on ne retrouve pas dans TS_1 ;

- TS_Dest : (facultatif) la plage (de type Range) qui représente le tableau structuré destination où afficher les données ;

- RemplacerOuAjouter : (facultatif) indique si les données doivent remplacer celles existantes dans le tableau structuré destination ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.

La fonction renvoie :

- Si TS_Dest n'est pas renseigné : une mémoire des valeurs uniques où la première valeur est en index 0, ou Null si aucune valeur trouvée.

- Si TS_Dest est renseigné : le nombre de lignes ajoutées au tableau destination ou -1 si erreur.

Exemples pour comparer les données de deux tableaux nommés "TS_1" et "TS_2" et alimenter trois tableaux "TS_Dest1", "TS_Dest2" et "TS_Dest3" respectivement, des données uniques communes aux deux tableaux, de celles qui ne sont présentes que dans le premier, de celles qui ne sont présentes que dans le second (les en-têtes de colonne sont identiques aux noms des tableaux structurés) :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Call TS_ComparerDeuxTableaux(Range("TS_1"), 1, Range("TS_2"), 1, 0, Range("TS_Dest1"), TS_RemplacerDonnées)
Call TS_ComparerDeuxTableaux(Range("TS_1"), 1, Range("TS_2"), 1, -1, Range("TS_Dest2"), TS_RemplacerDonnées)
Call TS_ComparerDeuxTableaux(Range("TS_1"), 1, Range("TS_2"), 1, 1, Range("TS_Dest3"), TS_RemplacerDonnées)
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_ComparerDeuxTableaux(TS_1 As Range, ByVal Colonne_1 As Variant, _
TS_2 As Range, ByVal Colonne_2 As Variant, _
Méthode As Integer, _
Optional TS_Dest As Range, _
Optional RemplacerOuAjouter As Enum_CopierDonnées = TS_RemplacerDonnées) As Variant
'------------------------------------------------------------------------------------------------------
' Compare les données de deux colonnes de deux tableaux structurés et renvoie les données identiques ou
' différentes (suivant la méthode de comparaison désirée) soit dans une variable soit dans un tableau.
'------------------------------------------------------------------------------------------------------
' TS_1 : La plage du premier Tableau Structuré.
' Colonne_1 : Le numéro de la colonne, ou le nom de la colonne du premier tableau.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' TS_2 : La plage du deuxième Tableau Structuré.
' Colonne_1 : Le numéro de la colonne, ou le nom de la colonne du deuxième tableau.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Méthode : 0 = renvoie les données que l'on retrouve dans TS_1 et dans TS_2.
'          -1 = renvoie les données de TS_1 que l'on ne retrouve pas dans TS_2.
'           1 = renvoie les données de TS_2 que l'on ne retrouve pas dans TS_1.
' TS_Dest : (facultatif) Le tableau structuré destination où afficher les données.
' RemplacerOuAjouter : (facultatif) énumération Enum_CopierDonnées =
'           TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
'           TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
'------------------------------------------------------------------------------------------------
' Renvoie : Si TS_Dest n'est pas renseigné : une mémoire des valeurs uniques où la première valeur est en index 0,
'           ou Null si aucune valeur trouvée.
'           Si TS_Dest est renseigné : le nombre de lignes ajoutées au tableau destination ou -1 si erreur.
'------------------------------------------------------------------------------------------------------
' Exemple d'utilisation sans tableau destination:
'Dim V
'V = TS_ComparerDeuxTableaux(Range("TS_1"), 1, Range("TS_2"), 1, 0)
'If IsNull(V) = True Then
'    MsgBox "Pas de donnée commune entre les deux tableaux"
'Else
'    MsgBox UBound(V) + 1 & " données communes comprises entre " & V(0) & " et " & V(UBound(V))
'End If
' Exemple d'utilisation avec un tableau destination:
'Dim V As Long
'V = TS_ComparerDeuxTableaux(Range("TS_1"), 1, Range("TS_2"), 1, 0, Range("TS_Dest"), TS_RemplacerDonnées)
'MsgBox V & " données communes entre les deux tableaux"
'------------------------------------------------------------------------------------------------------
Dim V1(), V2()
Dim i As Long, Id As Long
Dim NbAvant As Long

' Valeur renvoyée par défaut:
TS_ComparerDeuxTableaux = Null

' Retrouve le numéro de la colonne du premier tableau et vérifie sa cohérence (ou -1 si erreur):
Colonne_1 = TS_IndexColonne(TS_1, Colonne_1)
If Colonne_1 = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Retrouve le numéro de la colonne du deuxième tableau et vérifie sa cohérence (ou -1 si erreur):
Colonne_2 = TS_IndexColonne(TS_2, Colonne_2)
If Colonne_2 = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Mémorise les données source en valeurs uniques et triées:
V1 = TS_ValeurUnique(TS_1, Colonne_1)
V2 = TS_ValeurUnique(TS_2, Colonne_2)

' Dimensionne la variable qui contiendra le résultat:
i = TS_Nombre_Lignes(TS_1)
If TS_Nombre_Lignes(TS_2) > i Then i = TS_Nombre_Lignes(TS_2)
ReDim R(1 To i, 1 To 1)

' Traitement suivant la méthode demandée:
Select Case Méthode

' Données que l'on retrouve dans TS_1 et dans TS_2:
Case 0
For i = 0 To UBound(V1)
If RechercheDichotomique(V2, V1(i)) = True Then
Id = Id + 1
R(Id, 1) = V1(i)
End If
Next i

' Données de TS_1 que l'on ne retrouve pas dans TS_2 :
Case -1
For i = 0 To UBound(V1)
If RechercheDichotomique(V2, V1(i)) = False Then
Id = Id + 1
R(Id, 1) = V1(i)
End If
Next i

' Données de TS_2 que l'on ne retrouve pas dans TS_1 :
Case 1
For i = 0 To UBound(V2)
If RechercheDichotomique(V1, V2(i)) = False Then
Id = Id + 1
R(Id, 1) = V2(i)
End If
Next i

End Select

' S'il faut renseigner un tableau destination:
If TS_Dest Is Nothing = False Then
If RemplacerOuAjouter = TS_AjouterDonnées Then NbAvant = TS_Nombre_Lignes(TS_Dest)
Call TS_CopierUnTableau(R, TS_Dest, RemplacerOuAjouter)
Call TS_SupprimerPlusieursLignes(TS_Dest, Id + 1 + NbAvant, 0)
' Renvoie le nombre de lignes placées dans le tableau:
TS_ComparerDeuxTableaux = Id
' S'il faut renvoyer une variable:
ElseIf Id > 0 Then
ReDim V(0 To Id - 1) As Variant
For i = 0 To Id - 1
V(i) = R(i + 1, 1)
Next i
' Renvoie la variable:
TS_ComparerDeuxTableaux = V
End If

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ComparerDeuxTableaux", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ComparerDeuxTableaux"
End If

Err.Clear

End Function

'----------------------------------------------------------------------------------------
Private Function RechercheDichotomique(TabDonnées() As Variant, ByVal ValRecherchée As Variant) As Boolean
'----------------------------------------------------------------------------------------
Dim Début As Long, Fin As Long, i As Long, Anc As Long

Début = LBound(TabDonnées): Fin = UBound(TabDonnées): Anc = Début
If ValRecherchée > TabDonnées(Fin) Then Exit Function
If ValRecherchée < TabDonnées(Début) Then Exit Function

Do
i = (Début + Fin) / 2
If ValRecherchée > TabDonnées(i) Then
Début = i + 1
Anc = Début
Else
Fin = i - 1
End If
Loop While Début <= Fin

If ValRecherchée = TabDonnées(Anc) Then RechercheDichotomique = True

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

Comme indiqué au début de ce chapitre, la recherche dichotomique utilisée par cette fonction permet de rendre le traitement très rapide sur de grandes listes de données.
J'ai testé différentes méthodes sur deux listes de 50 000 lignes comprenant des nombres aléatoires compris entre 1 et 999 999.
Avec Application.Match le traitement prend 2 minutes, avec une requête SQL il passe à 10 secondes, et avec cette fonction : à moins d'une seconde.
Vous trouverez dans le fichier joint le détail de ces codes.

VII-J - TS_AlimenterColonne

La fonction TS_AlimenterColonne alimente une colonne d'un tableau structuré en effectuant l'équivalent d'un RechercheV sur l'ensemble des lignes d'une colonne. Mais contrairement à RechercheV elle permet d'indiquer plusieurs colonnes de référence dans les sources et non pas une seule.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré qu'il faudra alimenter ;

- Colonne : le numéro de la colonne ou le nom de la colonne qu'il faut alimenter, ou 0 pour traiter la dernière colonne ;

- TS_Recherche : la plage (de type Range) qui représente le tableau structuré où il faut rechercher ;

- ColonneRenvoyée : le numéro de la colonne ou le nom de la colonne dans le deuxième tableau structuré "TS_Recherche" dont il faut renvoyer les données, ou 0 pour traiter la dernière colonne ;

- RespecterCasse : True pour respecter la casse ou False pour l'ignorer ;

- EffacerSiNonTrouvé : indique s'il faut ou non effacer la cellule si la recherche est infructueuse (si True alors la cellule est effacée, si False elle est conservée) ;

- VisibleUniquement : si True ne traite que les lignes visibles, si False alors traite toutes les lignes ;

- ListeColonnes : la liste des couples colonnes de "TS" et de "TS_Recherche" de type ParamArray (tableau de paramètres) qui sont les clés (colonnes de référence) pour la recherche à effectuer.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour alimenter la colonne "Note 2" du tableau "TS_Eleves" qui contient les colonnes "Nom Famille" et "Prénom" pour identifier les élèves, en récupérant les notes dans le tableau "TS_Notes" qui contient les colonnes "NOM" et "PRENOM" pour identifier les élèves et la colonne "NOTE" pour la note. Si l'élève n'est pas trouvé dans la "TS_Notes" alors la note dans "Note 2" est conservée :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Call TS_AlimenterColonne(Range("TS_Eleves"), "Note 2", Range("TS_Notes"), "NOTE", True, False, False, _
"Nom Famille", "NOM", "Prénom", "PRENOM")
End Sub
'------------------------------------------------------------------------------------------------

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_AlimenterColonne(TS As Range, _
ByVal Colonne As Variant, _
TS_Recherche As Range, _
ByVal ColonneRenvoyée As Variant, _
RespecterCasse As Boolean, _
EffacerSiNonTrouvé As Boolean, _
VisibleUniquement As Boolean, _
ParamArray ListeColonnes() As Variant) As Boolean
'------------------------------------------------------------------------------------------------
' Alimente une colonne d'un tableau structuré en effectuant l'équivalent d'un RechercheV sur
' l'ensemble des lignes de la colonne. Utilise la technique de la recherche dans un objet ArrayList
' pour un traitement plus rapide. De même la colonne à modifier est mise en mémoire et les données
' sont modifiées dans cette mémoire puis elle vient alimenter la colonne à la fin du traitement,
' ce qui est plus rapide qu'une mise à jour au fil de l'eau du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré qu'il faudra alimenter.
' Colonne : Le numéro de la colonne, ou le nom de la colonne, qu'il faut alimenter.
'           Si vide ou 0 alors renvoie le numéro de la dernière colonne du tableau.
' TS_Recherche : La plage du Tableau Structuré où il faut rechercher.
' ColonneRenvoyée : Le numéro de la colonne, ou le nom de la colonne, dont il faut renvoyer les données
'                   pour alimenter la colonne de TS.
'                   Si vide ou 0 alors renvoie le numéro de la dernière colonne du tableau.
' RespecterCasse : True pour respecter la casse ou False pour l'ignorer.
' EffacerSiNonTrouvé : Indique s'il faut ou non effacer la cellule si la recherche est infructueuse.
'                      Si True alors la cellule est effacée, si False elle est conservée.
' VisibleUniquement : Si True ne traite que les lignes visibles.
' ListeColonnes : La liste des couples colonnes de TS et de TS_Recherche de type ParamArray
' (tableau de paramètres) qui sont les clés (colonnes de référence) pour la recherche à effectuer.
' https://docs.microsoft.com/fr-fr/office/vba/langage/concepts/getting-started/understanding-parameter-arrays.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Exemple pour alimenter la colonne "Note 2" du tableau "TS_Eleves" qui contient les colonnes
' "Nom Famille" et "Prénom" pour identifier les élèves, en récupérant les notes dans le tableau "TS_Notes"
' qui contient les colonnes "NOM" et "PRENOM" pour identifier les élèves et la colonne "NOTE" pour la note.
' Si l'élève n'est pas trouvé dans la "TS_Notes" alors la note dans "Note 2" est conservée.
' Call TS_AlimenterColonne(Range("TS_Eleves"), "Note 2", Range("TS_Notes"), "NOTE", True, False, False, _
'                         "Nom Famille", "NOM", "Prénom", "PRENOM")
'------------------------------------------------------------------------------------------------
Dim i As Long, y As Long
Dim Colonnes() As Variant
Dim ValCherchée As Variant
Dim Clé As String

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

' Retrouve le numéro de la colonne à alimenter et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Retrouve le numéro de la colonne à renvoyer et vérifie sa cohérence (ou -1 si erreur):
ColonneRenvoyée = TS_IndexColonne(TS_Recherche, ColonneRenvoyée)
If ColonneRenvoyée = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Chargement des colonnes du tableau destination et du tableau contenant la recherche (ou -1 si erreur):
For i = 0 To UBound(ListeColonnes) Step 2
ReDim Preserve Colonnes(0 To i + 1)
Colonnes(i) = TS_IndexColonne(TS, ListeColonnes(i))
If Colonnes(i) = -1 Then Err.Raise vbObjectError, , TS_Err_Description
Colonnes(i + 1) = TS_IndexColonne(TS_Recherche, ListeColonnes(i + 1))
If Colonnes(i + 1) = -1 Then Err.Raise vbObjectError, , TS_Err_Description
Next i

' Création d'un objet ArrayList:
Dim Liste As Object
Set Liste = CreateObject("System.Collections.ArrayList")

' Boucle sur les données du tableau de recherche:
For y = 1 To TS_Nombre_Lignes(TS_Recherche)
' Mémorise les colonnes de référence pour la recherche:
Clé = ""
For i = 1 To UBound(Colonnes) Step 2
Clé = Clé & "[" & TS_Recherche.ListObject.DataBodyRange(y, Colonnes(i)).Value & "]"
Next i
' S'il ne faut pas respecter la casse alors met tout en majuscules:
If RespecterCasse = False Then Clé = UCase(Clé)
' Mémorise la clé:
Liste.Add Clé
Next y

' Mémoire qui contiendra le résultat de la recherche pour alimenter la colonne destination:
ReDim R(1 To TS_Nombre_Lignes(TS), 1 To 1)
' Boucle sur les lignes du TS qu'il faut alimenter:
For y = 1 To TS_Nombre_Lignes(TS)
If VisibleUniquement = False Or TS.ListObject.DataBodyRange(y, 1).Height > 0 Then
' Constitue la valeur recherchée:
ValCherchée = ""
For i = 0 To UBound(Colonnes) Step 2
ValCherchée = ValCherchée & "[" & TS.ListObject.DataBodyRange(y, Colonnes(i)).Value & "]"
Next i
' S'il ne faut pas respecter la casse alors met tout en majuscules:
If RespecterCasse = False Then ValCherchée = UCase(ValCherchée)
' Si cette valeur est dans la liste:
i = 1 + Liste.IndexOf(ValCherchée, 0)
If i > 0 Then
' Alors mémorise la valeur:
R(y, 1) = TS_Recherche.ListObject.DataBodyRange(i, ColonneRenvoyée).Value
ElseIf EffacerSiNonTrouvé = False Then
R(y, 1) = TS.ListObject.DataBodyRange(y, Colonne).Value
End If
Else
R(y, 1) = TS.ListObject.DataBodyRange(y, Colonne).Value
End If
Next y

' Alimente la colonne désirée de la colonne à renvoyer:
Dim M
Call TS_Filtres_Mémoriser(TS, M)
Call TS_Filtres_Effacer(TS)
TS.ListObject.ListColumns(Colonne).DataBodyRange.Value = R
Call TS_Filtres_Restaurer(TS, M)

' Renvoie VRAI:
TS_AlimenterColonne = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_AlimenterColonne", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_AlimenterColonne"
End If
Err.Clear

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

VII-K - TS_ComboBox

La fonction TS_ComboBox alimente une zone de liste déroulante (ComboBox) de type ActiveX sur une feuille du classeur d'après les données source issues d'un tableau structuré.
Elle déclenche une macro personnelle suite à la validation d’un élément de la liste.
La sélection des données source se fait par une requête SQL ce qui permet une grande souplesse.
Une saisie est possible dans la zone de texte pour faciliter la sélection.
La sélection doit correspondre à un élément de la liste (CB.ListIndex <> -1) et être validée par la touche "[Entrée]" (KeyCode = 13) pour déclencher la macro personnelle liée, voir l'exemple ci-dessous.
La variable "TS_ChoixComboBox()" sera alimentée des valeurs des colonnes de la ligne sélectionnée et renvoyée comme argument de la macro liée (1er indice = 1) de type Sub MaMacro(X As Variant).
Vous pouvez associer (manuellement) une cellule liée à la ComboBox comme dans un cas classique et renseigner BoundColumn pour spécifier la valeur du contrôle pour cette cellule liée.

Ses arguments sont :

- CB : la zone de liste déroulante (ComboBox) ActiveX qu'il faut alimenter ;

- MacroLiée : le nom de la macro à exécuter quand un élément de la liste est validé ;

- TS : la plage (de type Range) qui contient les données source ;

- StrChamps : (facultatif) la liste des champs de la requête (ou tous les champs si vide ou non renseigné) ;

- StrSQL : (facultatif) la requête SQL ;

- NombreLignes : (facultatif) le nombre de lignes à afficher dans la liste déroulante ;

- ColonneClé : (facultatif) la colonne de référence qui alimentera la zone de saisie (voir ici) ;

- LargeurColonnes : (facultatif) la largeur des colonnes en pouces (0 pour masquer une colonne), chaîne de caractères où les valeurs sont séparées par un point-virgule (si vide alors les colonnes sont de même taille et leur cumul est égal à la taille de la ComboBox, voir ici).

Après sélection d'un élément de la liste :
CB.Value contient la valeur de la colonne indiquée dans BoundColumn (1 par défaut, 0 pour affecter ListIndex).
CB.Text contient la valeur de la colonne de référence (le texte affiché dans la zone de saisie = TextColumn).
CB.ListIndex représente le numéro de la ligne dans la liste déroulante (1er indice = 0).
CB.List(CB.ListIndex, x) contient la valeur de la xième colonne (1er indice = 0).

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.
La fonction renseigne : l'argument de la macro liée d'une variable à plusieurs indices (1er indice = 1) des valeurs des colonnes de la ligne sélectionnée.

Remarques :
- La liste déroulante est normalement initialisée à chaque ouverture (réception du focus) par l'événement Private Sub ComboBox1_GotFocus() afin d'avoir des données toujours actualisées. Toutefois sur des listes volumineuses et qui n'évoluent pas (ou rarement), il est préférable pour limiter les temps de traitement d'initialiser la liste par un événement à l'ouverture du classeur et de l'actualiser par un événement en cas de changement des données sources.
- La touche [Suppr] efface la saisie faite.
- La touche [Inser] restaure la dernière saisie validée.

Exemple d'utilisation pour sélectionner un élément dans une liste déroulante ActiveX nommée "ComboBox1" et lancer la fonction "MaMacro" quand un élément est sélectionné puis validé par la touche [Entrée].
L'utilisateur peut saisir un prénom (colonne 2 de la liste) pour présélectionner un élément.

La liste déroulante est initialisée d’après une requête SQL sur le tableau structuré de gauche

Placez dans le code de la feuille où est la ComboBox ces deux événements (le 1er pour initialiser la zone de liste à la réception du focus, le second pour contrôler la sélection faite à chaque saisie et déclencher la macro liée s'il y a une validation).
La requête SQL sélectionne les noms, prénoms et numéro Id du tableau "TS_Eleves" et les trie pas ordre croissant. La 3e colonne ne sera pas visible dans la liste déroulante :

'------------------------------------------------------------------------------------------------
Private Sub ComboBox1_GotFocus()
'------------------------------------------------------------------------------------------------
' Alimente la liste déroulante d'après trois colonnes du tableau "TS_Eleves" (Id ne sera pas visible):
Call TS_ComboBox(CB:=ComboBox1, _
MacroLiée:="MaMacro", _
TS:=Range("TS_Eleves"), _
StrChamps:="[Nom Famille], [Prénom], [Id]", _
StrSQL:="ORDER BY [Nom Famille]", _
ColonneClé:=2, _
LargeurColonnes:="60;60;0")
End Sub

'------------------------------------------------------------------------------------------------
Private Sub ComboBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
'------------------------------------------------------------------------------------------------
Call TS_ComboBox(ComboBox1, Int(KeyCode))
End Sub
'------------------------------------------------------------------------------------------------

Placez la macro "MaMacro" dans un module classique.
Elle fera la mise à jour du tableau structuré (par une requête SQL) d'après la valeur "Id" (3e colonne) de la sélection faite, en mettant la valeur "Bleu" dans la colonne "Couleur". L'argument "Choix" de cette fonction contient les valeurs des colonnes (1er indice = 1) :

'------------------------------------------------------------------------------------------------
Sub MaMacro(Choix As Variant)
'------------------------------------------------------------------------------------------------
Call TS_ModifierSQL(TS:=Range("TS_Eleves"), _
Colonne:="Couleur", _
StrSQL:="WHERE [id]=" & Choix(3), _
Valeur:="Bleu", _
Méthode:=TS_Update_Valeur)
End Sub
'------------------------------------------------------------------------------------------------

Astuce : vous pouvez faire un événement sur clic dans la liste pour forcer la validation sans avoir à valider par [Entrée] :

'------------------------------------------------------------------------------------------------
Private Sub ComboBox1_Click()
'------------------------------------------------------------------------------------------------
Call TS_ComboBox(ComboBox1, Int(13))
End Sub
'------------------------------------------------------------------------------------------------

Dans cet exemple, une première ComboBox affiche la liste des communes sans doublon. Après validation la fonction liée "SelectionnerVille_1" compte le nombre de commune portant ce nom.
S’il y en a plusieurs une seconde ComboBox affiche la liste des communes portant ce nom pour permettre à l’utilisateur d’affiner son choix.
La ville sélectionnée est mise en surbrillance dans le tableau source.

En cas de doublon sur le nom d’une commune une seconde ComboBox est renseignée

Si l’initialisation de la première ComboBox se fait par un événement sur réception du focus :

'------------------------------------------------------------------------------------------------
Private Sub ComboBox1_GotFocus()
'------------------------------------------------------------------------------------------------------
' Efface la ComboBox2:
ActiveSheet.ComboBox2.Text = ""
ActiveSheet.ComboBox2.Clear

' Initialise la liste des villes sans doublon:
Call TS_ComboBox(CB:=ComboBox1, _
MacroLiée:="SelectionnerVille_1", _
TS:=Range("TS_CP"), _
StrChamps:="[Commune]", _
StrSQL:="GROUP BY [Commune] ORDER BY [Commune]", _
ColonneClé:=1, _
LargeurColonnes:="150")

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

La seconde sera faite à l’intérieur de la macro "SelectionnerVille_1" :

'------------------------------------------------------------------------------------------------
Sub SelectionnerVille_1(Choix)
'------------------------------------------------------------------------------------------------------
Dim i As Long
Dim Tableau As Range
Set Tableau = Range("TS_CP")

' Si le nom de la commune est unique dans la liste:
If Application.Evaluate("=COUNTIF(TS_CP[Commune],""" & Choix(1) & """)") = 1 Then

' Alors recherche sa position dans le tableau et sélectionne toute la ligne:
Call TS_Filtres_Effacer(Tableau)
i = TS_RechercherVisible(Tableau, "Commune", Choix(1), False, TS_Valeurs, xlWhole)
' Met la ligne en jaune:
Tableau.ListObject.DataBodyRange.Interior.Color = xlNone
Tableau.ListObject.DataBodyRange.Rows(i).Interior.Color = 65535
Application.Goto Tableau.ListObject.DataBodyRange.Rows(i), True
[A1].Select

Else

' Initialise la liste des communes portant le nom sélectionnné, contenu dans Choix(1):
ActiveSheet.ComboBox2.Activate
Call TS_ComboBox(CB:=ActiveSheet.ComboBox2, _
MacroLiée:="SelectionnerVille_2", _
TS:=Range("TS_CP"), _
StrChamps:="[Commune], [Code postal], [Département], [Insee]", _
StrSQL:="WHERE [Commune] = " & TS_FormatSQL(Choix(1), TS_Chaine), _
NombreLignes:=15, _
ColonneClé:=3, _
LargeurColonnes:="110;50;150;0")

End If

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

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Function TS_ComboBox(CB As ComboBox, MacroLiée As String, _
Optional TS As Range, _
Optional ByVal StrChamps As String = "", _
Optional ByVal StrSQL As String = "", _
Optional ByVal NombreLignes As Integer = 8, _
Optional ByVal ColonneClé As Integer = 1, _
Optional ByVal LargeurColonnes As String = "") As Boolean
'------------------------------------------------------------------------------------------------
' CB : la zone de liste déroulante (ComboBox) ActiveX qu'il faut alimenter.
' MacroLiée : le nom de la macro à exécuter quand un élément de la liste est validé.
' TS : la plage du Tableau Structuré qui contient les données.
' StrChamps : (facultatif) la liste des champs de la requête (ou tous les champs si vide ou non renseigné).
' StrSQL : (facultatif) la requête SQL.
' NombreLignes : (facultatif) le nombre de lignes à afficher dans la liste déroulante.
' ColonneClé : (facultatif) la colonne de référence qui alimentera la zone de saisie.
'              (https://learn.microsoft.com/fr-fr/office/vba/api/outlook.combobox.textcolumn)
' LargeurColonnes : (facultatif) la largeur des colonnes en pouces (0 pour masquer une colonne).
'                   Chaîne de caractères où les valeurs sont séparées par un point-virgule. Si vide alors
'                   les colonnes sont de même taille et leur cumul est égal à la taille de la ComboBox.
'                   (https://learn.microsoft.com/fr-fr/office/vba/api/access.combobox.columnwidths)
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
' Renseigne : l'argument de la macro liée d'une variable à plusieurs indices (1er indice = 1)
'             des valeurs des colonnes de la ligne sélectionnée.
'------------------------------------------------------------------------------------------------
Dim Enr As Variant, i As Integer, Nb As Long

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

' Si la fonction est appelée suite à une saisie au clavier (événement Private Sub ComboBox1_KeyUp):
If IsNumeric(MacroLiée) = True Then
' Analyse la saisie et lance la macro s'il s'agit d'une validation d'un élément:
Call TS_ComboBoxAnalyseSaisie(CB, Int(MacroLiée))
Exit Function
End If

' Lance la requête pour charger les éléments de la liste:
Set Enr = TS_RequeteSQL(TS, StrChamps, StrSQL)

' Efface la liste existante:
Application.EnableEvents = False
CB.Clear

' Pour le bug sur l'affichage sur ouverture par la flèche (DropDown):
SendKeys "{Enter}"

' Si la requête renvoie un jeu d'enregistrements:
If Not Enr Is Nothing Then

' Traitement bien plus rapide qu'une boucle sur le jeu d'enregistrement et
' création d'un ligne par CB.AddItem puis alimentation par
' CB.List(Nb - 1, i) = Enr.Fields(i).Value

' Création d'un tableau qui va contenir la liste des données:
ReDim V(0 To Enr.RecordCount - 1, 0 To Enr.Fields.Count - 1)
' Boucle sur le jeu d'enregistrements pour alimenter ce tableau:
For Nb = 1 To Enr.RecordCount
For i = 0 To Enr.Fields.Count - 1
V(Nb - 1, i) = Enr.Fields(i).Value
Next i
Enr.MoveNext
Next Nb
' Transfert le tableau dans la zone de liste:
CB.List() = V()

' Mémorise la macro liée (dans AltHTML):
CB.AltHTML = MacroLiée
' Dénifinition du nombre de colonnes:
CB.ColumnCount = i
CB.ListRows = NombreLignes
' Définition de la colonne clé et de leur largeur:
CB.TextColumn = ColonneClé
CB.ColumnWidths = LargeurColonnes
' Autres configurations:
CB.AutoLoad = True
CB.AutoWordSelect = True
CB.ColumnHeads = False
CB.Enabled = True
CB.Locked = False
CB.MatchEntry = fmMatchEntryComplete
CB.MatchRequired = True
CB.MaxLength = 0
End If

' Ouvre la liste:
DoEvents
CB.BringToFront
CB.DropDown

' Renvoie VRAI:
TS_ComboBox = True

' Fin du traitement:
Gest_Err:
Application.EnableEvents = True
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ComboBox", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ComboBox"
End If
Err.Clear

End Function

'------------------------------------------------------------------------------------------------
Private Sub TS_ComboBoxAnalyseSaisie(CB As ComboBox, ByVal KeyCode As Integer)
'------------------------------------------------------------------------------------------------
' Touche [Suppr] pour effacer le texte affiché:
If KeyCode = 46 Then CB.Text = "": CB.BringToFront: CB.DropDown

' Touche [Inser] pour restituer le dernier choix validé:
If KeyCode = 45 Then CB.Text = CB.ShapeRange.AlternativeText: CB.DropDown

' Touche [Entrée] pour valider une sélection de la liste:
If KeyCode = 13 And CB.ListIndex <> -1 Then
Dim i As Integer
ReDim TS_ChoixComboBox(1 To CB.ColumnCount)
' Mémorise les valeurs des différentes colonnes:
For i = 1 To CB.ColumnCount
TS_ChoixComboBox(i) = CB.List(CB.ListIndex, i - 1)
Next i
' Mémorise le choix validé:
CB.ShapeRange.AlternativeText = CB.Text
' Si une macro est liée alors la lancer (et sortir de la liste déroulante):
If CB.AltHTML <> "" Then
ActiveCell.Select
Application.Run CB.AltHTML, TS_ChoixComboBox
End If
End If

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

Vous retrouverez l’intégralité des codes dans le fichier joint sur la feuille « Villes » et dans le module « Module_Test_ComboBox ».

VII-L - TS_RangeDansClasseur

La fonction TS_RangeDansClasseur renvoie l'objet Range correspondant à un tableau structuré situé dans un classeur autre que celui qui est actif sans avoir à connaitre le nom de la feuille où il se trouve. C'est cet objet qui sera utilisé dans nos fonctions pour gérer les tableaux structurés.

Souvenez-vous que lorsque l'on manipule un tableau du classeur actif il n'est pas nécessaire d'indiquer le nom de la feuille où il se situe, mais lorsqu'il est dans un autre classeur il faut renseigner la feuille concernée. Qui n'est pas toujours connue ou qui peut avoir été changée.

Nous verrons un exemple d'utilisation dans le chapitre suivant.

Ses arguments sont :

- Classeur : le classeur (de type Workbook) qui contient le tableau structuré ;

- TS_Nom : le nom du tableau structuré.

La fonction renvoie : un objet Range si tout s’est bien passé ou Nothing dans le cas contraire.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_RangeDansClasseur(Classeur As Workbook, TS_Nom As String) As Range
'------------------------------------------------------------------------------------------------
Dim Ws, Ref

For Each Ws In Classeur.Worksheets
For Each Ref In Ws.ListObjects
If Ref.Name = TS_Nom Then
Set TS_RangeDansClasseur = Classeur.Sheets(Ws.Name).Range(TS_Nom): Exit Function
End If
Next Ref
Next Ws

Err.Raise vbObjectError, "TS_RangeDansClasseur", "Le tableau [" & TS_Nom & "] n'est pas trouvé dans le classeur " & Classeur.FullName & "."
End Function
'------------------------------------------------------------------------------------------------

VII-M - TS_OuvrirClasseur et TS_FermerClasseur

La fonction TS_OuvrirClasseur ouvre un classeur externe en le rendant visible ou non. Le rendre non visible permet de faire des manipulations sans que l'utilisateur soit perturbé par les affichages à l'écran.

Un fichier en lecture seule peut être modifié car la fonction faut sauter cet attribut temporairement puis le remet à la fermeture par la fonction TS_FermerClasseur.

La fonction TS_FermerClasseur fermera ce classeur en l'enregistrant ou non, suivant votre choix.

Les arguments de la fonction TS_OuvrirClasseur sont :

- Fichier : le classeur Excel qu'il faut ouvrir (chemin complet + nom avec l'extension) ;

- Visible : True pour afficher le classeur ou False pour le masquer ;

- MotDePasseOuverture : éventuellement le mot de passe pour ouvrir le fichier (vide si non nécessaire) ;

- MotDePasseEcriture : éventuellement le mot de passe pour modifier le fichier (vide si non nécessaire) ;

- MAJ_Liens : mettre Vrai s'il faut faire une mise à jour des liens à l'ouverture du classeur ;

- DésactiveMacros : mettre Vrai pour désactiver les macros et les événements y compris Workbook_Open.

La fonction renvoie : l'objet Workbook du classeur si tout s’est bien passé ou Nothing dans le cas contraire.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_OuvrirClasseur(Fichier As String, _
Visible As Boolean, _
Optional MotDePasseOuverture As String = "", _
Optional MotDePasseEcriture As String = "", _
Optional MAJ_Liens As Boolean = False, _
Optional DésactiveMacros As Boolean = True) As Workbook
'------------------------------------------------------------------------------------------------------
' Ouvre un classeur Excel en le mettant invisible si "Visible" = False pour que l'utilisateur ne soit pas perturbé par les
' manipulations qui y sont faites. Un fichier en lecture seule peut être modifié car la fonction faut sauter
' cet attribut temporairement puis le remet à la fermeture par la fonction "FermerClasseur".
'------------------------------------------------------------------------------------------------------
' Fichier : le classeur Excel qu'il faut ouvrir (chemin complet + nom avec l'extension).
' Visible : False pour masquer le classeur.
' MotDePasseOuverture : éventuellement le mot de passe pour ouvrir le fichier (vide si non nécessaire).
' MotDePasseEcriture : éventuellement le mot de passe pour modifier le fichier (vide si non nécessaire).
' MAJ_Liens : mettre Vrai s'il faut faire une mise à jour des liens à l'ouverture du classeur.
' DésactiveMacros : mettre Vrai pour désactiver les macros et les événements y compris Workbook_Open.
'------------------------------------------------------------------------------------------------------
' La fonction renvoie l'objet Workbook du classeur si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim Wk As Workbook
Dim Filenum As Long
Dim ObjFile As Object
Dim Anc_ScreenUpdating As Boolean
Dim Attributs As Long
Dim Anc_Wk As Workbook

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

' Bloque la mise à jour de l'écran:
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' Mémorise le classeur actif:
Set Anc_Wk = ActiveWorkbook

' Une erreur est déclenchée si le fichier source n'est pas trouvé:
Set ObjFile = CreateObject("Scripting.FileSystemObject").GetFile(Fichier)
' Supprime l'attribut lecture seule:
Attributs = ObjFile.Attributes
ObjFile.Attributes = 0
' Une erreur est déclenchée s'il est déjà ouvert:
Filenum = FreeFile()
Open Fichier For Binary Lock Read Write As #Filenum
Close Filenum

' Désactive les macros pour ouvrir le fichier sans lancer "Workbook_Open":
If UCase(Right(Fichier, 5)) <> ".XLSX" And DésactiveMacros = True Then
Dim secAutomation As MsoAutomationSecurity
secAutomation = Application.AutomationSecurity
Application.AutomationSecurity = msoAutomationSecurityForceDisable
' Ouvre le fichier (sans mettre à jour les liens si MAJ_Liens=False):
Set Wk = Workbooks.Open(Fichier, MAJ_Liens, False, , MotDePasseOuverture, MotDePasseEcriture, True)
' Réactive les macros:
Application.AutomationSecurity = secAutomation
Else
' Ouvre le fichier (sans mettre à jour les liens si MAJ_Liens=False):
Set Wk = Workbooks.Open(Fichier, MAJ_Liens, False, , MotDePasseOuverture, MotDePasseEcriture, True)
End If

' Masque le classeur que l'on vient d'ouvrir:
Windows(Wk.Name).Visible = Visible

' Restaure l'attribut d'origine:
ObjFile.Attributes = Attributs

' Restaure le classeur appelant:
Anc_Wk.Activate

' Renvoie le classeur:
Set TS_OuvrirClasseur = Wk

' Gestion des erreurs:
Gest_Err:

Application.ScreenUpdating = Anc_ScreenUpdating
If Err.Number = 53 Then Err.Description = Err.Description & " : " & vbCrLf & Fichier
If Err.Number = 70 Then Err.Description = Err.Description & " : Le classeur " & vbCrLf & Fichier & vbCrLf & "doit être déjà ouvert."

TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If Not ObjFile Is Nothing Then ObjFile.Attributes = Attributs
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_OuvrirClasseur", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_OuvrirClasseur"
End If

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

Les arguments de la fonction TS_FermerClasseur sont :

- Classeur : l'objet Workbook à fermer ;

- Enregistrer : mettre True pour enregistrer le classeur, ou False pour le fermer sans l'enregistrer.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_FermerClasseur(Classeur As Workbook, Enregistrer As Boolean) As Boolean
'------------------------------------------------------------------------------------------------------
' Ferme un classeur (normalement préalablement ouvert avec TS_OuvrirClasseur) et l'enregistre ou non.
'------------------------------------------------------------------------------------------------------
' Classeur : l'objet Workbook à fermer.
' Enregistrer : mettre à Vrai s'il faut enregistrer le classeur.
'------------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim ObjFile As Object
Dim Anc_ScreenUpdating As Boolean
Dim Attributs As Long

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

' Bloque la mise à jour de l'écran:
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False

' Si le classeur est toujours actif:
If TypeName(Classeur) = "Workbook" Then

' S'il faut l'enregistrer:
If Enregistrer = True Then
' Une erreur est déclenchée si le fichier source n'est pas trouvé:
Set ObjFile = CreateObject("Scripting.FileSystemObject").GetFile(Classeur.FullName)
' Mémorise l'attribut du fichier puis supprime la lecture seule:
Attributs = ObjFile.Attributes
ObjFile.Attributes = 0
Windows(Classeur.Name).Visible = True
Classeur.Activate
Application.WindowState = xlMinimized
Classeur.Save
' Restaure l'attribut:
ObjFile.Attributes = Attributs
End If

' Ferme le fichier:
Classeur.Saved = True
Classeur.Close

' Renvoie Vrai:
TS_FermerClasseur = True

End If

' Gestion des erreurs:
Gest_Err:

Application.ScreenUpdating = Anc_ScreenUpdating
If Err.Number <> 0 Then Err.Raise Err.Number

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

Exemple d'utilisation pour remplacer les données du tableau « TS_Eleves » contenues dans le classeur « C:\Users\ott_l\Downloads\Test_TS.xlsm » sur la feuille dont nous ne connaissons pas le nom (ou qui pourrait éventuellement changer) par les données du tableau « TS_Eleves » du classeur « C:\Users\ott_l\Downloads\Classeur_Elèves.xlsx ».
Notez ici l'usage de la fonction TS_RangeDansClasseur qui permet de retrouver le tableau sans avoir à indiquer le nom de la feuille concernée.
Dans notre exemple les macros n'ont pas été désactivées car nous allons lancer celle contenue dans le classeur « Test_TS.xlsm » qui met en forme le tableau.

Le code  :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear

Dim Wk_S As Workbook
Set Wk_S = TS_OuvrirClasseur("C:\Users\ott_l\Downloads\Classeur_Elèves.xlsx", False)

Dim Wk_D As Workbook
Set Wk_D = TS_OuvrirClasseur(Fichier:="C:\Users\ott_l\Downloads\Test_TS.xlsm", Visible:=False, DésactiveMacros:=False)

Dim TS As Range: Set TS = TS_RangeDansClasseur(Wk_S, "TS_Eleves")
Dim TD As Range: Set TD = TS_RangeDansClasseur(Wk_D, "TS_Eleves")

Call TS_CopierUnTableau(TS, TD, TS_RemplacerDonnées, TS_Valeurs)

' Active le classeur qui contient la macro à exécuter:
Wk_D.Activate
Application.Run "Test_TS.xlsm!'MiseEnForme'"

Call TS_FermerClasseur(Wk_S, False)
Call TS_FermerClasseur(Wk_D, True)

MsgBox "fin du traitement"

Gest_Err:

If Err.Number <> 0 Then
MsgBox Err.Number & " : " & Err.Description, vbExclamation
Call TS_FermerClasseur(Wk_S, False)
Call TS_FermerClasseur(Wk_D, True)
End If
Err.Clear

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

VII-N - TS_AES

Vous avez des données confidentielles dans un classeur Excel qui doit être partagé. Vous souhaitez donc que ces données ne soient pas visibles.
Malheureusement, les ingénieurs de Microsoft n’ont pas muni Excel d’outils pour masquer une feuille, ou le code d’un projet VBA, capables de résister aux pirates.
Une solution est de chiffrer les données sensibles avec un mot de passe en utilisant un algorithme qui a fait ses preuves.

La fonction TS_AES (que vous trouverez dans le module « TS_AES_Rijndael » du fichier joint) chiffre et déchiffre les données d’un tableau structuré (ou de certaines de ses colonnes) en utilisant l’algorithme de cryptographie symétrique « AES / Rijndael » (la source est présentée dans le code).

Le mot de passe utilisé sera à saisir dans une boîte de dialogue InputBox.
Pour éviter les attaques par la force brute il est recommandé d’utiliser un mot de passe d’au moins 10 caractères.
Cette fonction traite environ 1 500 cellules par secondes, elle est donc peu adaptée aux gros tableaux.

Ses arguments sont :

- TS_AES_Action : l’action de cryptologie à traiter suivant l'énumération personnelle Enum_TS_AES_Action :
- TS_AES_Chiffrer : pour chiffrer,
- TS_AES_Déchiffrer : pour déchiffrer ;

- TS : la plage du Tableau Structuré ;

- ListeColonnes : la ou les colonnes concernées (dans ce cas passez un Array) ;

- VisibleUniquement : si True ne traite que les lignes visibles (False par défaut).

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire, et renseigne alors TS_Err_Number et TS_Err_Description.

Remarques :

- les cellules chiffrées sont représentées par une arobase @ ;

- la fonction de déchiffrement vérifie que l’arobase est le premier caractère d’une cellule avant de la déchiffrer ;

- lors du déchiffrement un contrôle vérifie que l'adresse de la cellule déchiffrée correspond à l'adresse de la cellule chiffrée, dit autrement, si un utilisateur a fait un copier/coller d'une autre cellule chiffrée pour remplacer la cellule à déchiffrer (par erreur ou dans l'intention de nuire) un message le signale, la cellule est mise en fond rouge et la fonction renvoie False.

Exemple avec ce tableau où nous allons chiffrer les moyennes et les commentaires déjà renseignés avant de l’envoyer pour être complété :

Les cellules chiffrées sont représentées par une arobase

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------------
Sub Exemple_Chiffrer()
'------------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")

' N'affiche que les commentaires réalisés:
Call TS_Filtres_Poser(Tableau, "Commentaire", ">""")

' Chiffre les moyennes et les commentaires qui sont visibles:
If TS_AES(TS_AES_Chiffrer, Tableau, Array("Moyenne", "Commentaire"), True) = False Then
MsgBox TS_Err_Number & " : " & TS_Err_Description, vbCritical
End If

' Efface le filtre pour afficher tout le tableau:
Call TS_Filtres_Effacer(Tableau)

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

Pour déchiffrer les cellules chiffrées vous pouvez passer en argument l’intégralité du tableau, car la fonction identifie les cellules chiffrées :

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------------
Sub Exemple_Déchiffrer()
'------------------------------------------------------------------------------------------------------
' Déchiffre tout le tableau (la fonction ne traitera que les données chiffrées identifiées par @) :
If TS_AES(TS_AES_Déchiffrer, Range("TS_Eleves"), "", False) = False Then
MsgBox TS_Err_Number & " : " & TS_Err_Description, vbCritical
End If

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

Le code de la fonction TS_AES :

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------------
'https://github.com/EszopiCoder/vba-crypto/blob/master/modCspAES256.bas
'------------------------------------------------------------------------------------------------------

Option Explicit

'Attribute VB_Name = "modCspAES256"
'********************************************************************************
' MIT License
'
' Copyright (c) 2019 EszopiCoder
'
' Permission is hereby granted, free of charge, to any person obtaining a copy
' of this software and associated documentation files, to deal
' in the Software without restriction, including without limitation the rights
' to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
' copies of the Software, and to permit persons to whom the Software is
' furnished to do so, subject to the following conditions:
'
' The above copyright notice and this permission notice shall be included in all
' copies or substantial portions of the Software.
'
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
' IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
' FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
' AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
' LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
' OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
' SOFTWARE.
'
' Contact: pharm.coder@gmail.com
'
'********************************************************************************
'
' The code below contains sample functions for AES 256 encryption within VBA.
' The user must supply their own key and initialization vector. It is recommended
' that the initialization vector be randomly generated to prevent attacks on the
' encryption.
'
' The key and initialization vector must be the following size:
' Key: 256 bits (32 characters)
' IV: 128 bits (16 characters)
'
' Sample test code is provided demonstrating the basic application of functions.
'
' Reference(s):
' https://docs.microsoft.com/en-us/dotnet/api/system.security.cryptography.rijndaelmanaged?view=netframework-4.8
'
'********************************************************************************

' CipherMode Constants
Private Const CBC = 1 ' Cipher Block Chaining (Default)
Private Const ECB = 2 ' Electronic Codebook
Private Const OFB = 3 ' Output Feedback
Private Const CFB = 4 ' Cipher Feedback
Private Const CTS = 5 ' Cipher Text Stealing

' PaddingMode Constants
Private Const None = 1
Private Const PKCS7 = 2
Private Const Zeros = 3 ' Default
Private Const ANSIX923 = 4
Private Const ISO10126 = 5

' Encoding Constants
Private Const Base64 = 0 ' Default
Private Const Hex = 1

Public Enum Enum_TS_AES_Action
TS_AES_Chiffrer
TS_AES_Déchiffrer
End Enum

'----------------------------------------------------------------------------------------
Function TS_AES(TS_AES_Action As Enum_TS_AES_Action, TS As Range, _
Optional ByVal ListeColonnes As Variant = "", _
Optional VisibleUniquement As Boolean = False) As Boolean
'----------------------------------------------------------------------------------------
' Chiffre ou déchiffre un tableau structuré, ou certaines colonnes, les lignes filtrées
' masquées sont prises en compte sauf si VisibleUniquement est à VRAI.
' 1 seconde de traitement pour environ 1500 cellules chiffrées/déchiffrées.
'------------------------------------------------------------------------------------------------
' TS_AES_Action : le mode de traitement, TS_AES_Chiffrer pour chiffrer, TS_Déchiffer pour déchiffrer
' TS : la plage du Tableau Structuré.
' ListeColonnes : la ou les colonnes concernées (dans ce cas passer un Array),
'                 voir ci-dessous les exemples d'appels.
' VisibleUniquement : si VRAI ne traite que les lignes visibles (FAUX par défaut).
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé ou FAUX dans le cas contraire.
'------------------------------------------------------------------------------------------------
' Exemples :
'Dim TS As Range
'Set TS = Range("TS_Eleves")
'Call TS_AES(TS_AES_Chiffrer, TS) ' chiffre tout le tableau.
'Call TS_AES(TS_AES_Chiffrer, TS, "Nom") ' chiffre la colonne nommée Nom.
'Call TS_AES(TS_AES_Chiffrer, TS, Array("Nom", "Prénom")) ' chiffre les colonnes Nom et Prénom.
'Call TS_Filtres_Poser([TS_Eleves],"Commentaire", ">""") ' n'affiche que les commentaires.
'------------------------------------------------------------------------------------------------
Dim Colonnes As Variant, i As Integer, y As Long, k As Long, k2 As Long, Ctrl As String, NbErr As Long
Dim MDP As String
Dim Chaine As String
Dim Total As Long, Encours As Long

' Mémorise les états:
Dim Anc_ScreenUpdating As Boolean
Dim Anc_Cursor As Long
Dim Anc_StatusBar As Boolean
Dim Anc_Calculation As XlCalculation
Dim Anc_EnableEvents As Boolean
Dim Anc_EnableCancelKey As Boolean

Anc_Cursor = Application.Cursor
Anc_ScreenUpdating = Application.ScreenUpdating
Anc_StatusBar = Application.DisplayStatusBar
Anc_Calculation = Application.Calculation
Anc_EnableEvents = Application.EnableEvents
Anc_EnableCancelKey = Application.EnableCancelKey

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

' Saisie du mot de passe:
MDP = InputBox("Saisie du mot de passe : ", IIf(TS_AES_Action = TS_AES_Chiffrer, "Chiffrer un tableau", "Déchiffrer un tableau"))
If MDP = "" Then TS_AES = True: GoTo Gest_Err

' Bloque les mises à jour de l'écran:
Application.Cursor = xlWait
Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.EnableCancelKey = False

' Récupère le numéro des colonnes:
If IsArray(ListeColonnes) = True Then
Colonnes = TS_IndexColonne(TS, ListeColonnes(0))
For i = 1 To UBound(ListeColonnes)
Colonnes = Colonnes & "," & TS_IndexColonne(TS, ListeColonnes(i))
Next i
Else
' S'il faut tout prendre:
If ListeColonnes = "" Then
For i = 1 To TS.ListObject.ListColumns.Count
Colonnes = Colonnes & "," & i
Next i
Else ' S'il n'y a qu'une colonne au format String:
Colonnes = TS_IndexColonne(TS, ListeColonnes)
End If
End If

' Transforme les colonnes dans une liste:
ListeColonnes = Split(Colonnes, ",")
Total = (1 + UBound(ListeColonnes)) * TS.ListObject.ListRows.Count

' Boucle sur la liste des colonnes à traiter:
For i = LBound(ListeColonnes) To UBound(ListeColonnes)
If ListeColonnes(i) <> "" Then

' Boucle sur les lignes:
For y = 1 To TS.ListObject.ListRows.Count

' Progression:
Encours = Encours + 1
If Encours Mod 1500 = 0 Then
Application.StatusBar = "Traitement : " & Format(Encours / Total, "0%"): DoEvents
End If

' Pour chaque cellule:
With TS.ListObject.DataBodyRange(y, Val(ListeColonnes(i)))

' S'il ne faut chiffrer que les cellules visible ou toutes les cellules:
If VisibleUniquement = False Or .Height > 0 Then

Select Case TS_AES_Action

Case TS_AES_Chiffrer
Chaine = "@" & .NumberFormatLocal & "¶"           ' Place @ et le format numérique puis Chr(182).
Chaine = Chaine & TS.ListObject.Name _
& TS.ListObject.ListColumns(Val(ListeColonnes(i))).Name _
& y & "¶"                                 ' Y ajoute les coordonnées de la cellule puis Chr(182).
Chaine = Chaine & .FormulaLocal                   ' Y ajoute la formule locale.
Chaine = AES_ChiffrerChaine(Chaine, MDP)          ' Chiffre le tout.
.FormulaLocal = "@" & Chaine                      ' Place @ et le chiffrement en formule locale.
.NumberFormat = ";;;""@"""                        ' Force le format numérique pour afficher @.

Case TS_AES_Déchiffrer
' Récupère la formule locale et vérifie qu'elle commence par @:
Chaine = .FormulaLocal
If Left(Chaine, 1) = "@" Then
Chaine = Mid(Chaine, 2)                      ' Récupère le chiffrement.
Chaine = AES_DéchiffrerChaine(Chaine, MDP)   ' Retrouve la chaine d'origine.
' Si l'entête est retrouvé:
k = InStr(1, Chaine, "¶")
If k > 0 Then
k2 = InStr(k + 1, Chaine, "¶")
If k2 > 0 Then
.FormulaLocal = Mid(Chaine, k2 + 1)          ' Place en formule locale sans l'entête.
.NumberFormatLocal = Mid(Chaine, 2, k - 2)   ' Récupère le format numérique d'origine.
Ctrl = Mid(Chaine, k + 1, k2 - k - 1)        ' Contrôle les coordonnées de la cellule.
' Si les coordonnées de la cellule ne sont pas identiques à l'origine:
If Ctrl <> TS.ListObject.Name _
& TS.ListObject.ListColumns(Val(ListeColonnes(i))).Name & y Then
.Interior.Color = vbRed ' Met en fond rouge.
.Font.Color = vbWhite   ' Et en texte blanc.
NbErr = NbErr + 1       ' Compte le nombre d'erreur.
End If
End If
End If
End If

End Select

End If
End With

Next y

End If
Next i

' Si des cellules chiffrées ont été modifiées:
Select Case NbErr
Case Is > 1: Err.Raise vbObjectError, , vbCrLf & "ATTENTION : " & NbErr & " cellules chiffrées ont été modifiées." & vbCrLf & "Elles sont en fond rouge pour être identifiées."
Case 1: Err.Raise vbObjectError, , vbCrLf & "ATTENTION : une cellule chiffrée à été modifiée." & vbCrLf & "Elle est en fond rouge pour être identifiée."
End Select

' Renvoie VRAI:
TS_AES = True

' Fin du traitement:
Gest_Err:
Application.StatusBar = False
Application.DisplayStatusBar = Anc_StatusBar
Application.Cursor = Anc_Cursor
Application.ScreenUpdating = Anc_ScreenUpdating
Application.EnableEvents = Anc_EnableEvents
Application.EnableCancelKey = Anc_EnableCancelKey
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function AES_ChiffrerChaine(Chaine As String, MotDePasse As String, Optional Encoding As Integer = Base64)
'----------------------------------------------------------------------------------------
' Chiffre la chaîne passée en argument avec le mot de passe indiqué, et la renvoie.
' Réserver Encoding = 1 pour le chiffrage binaire uniquement.
'----------------------------------------------------------------------------------------
AES_ChiffrerChaine = EncryptStringAES(Chaine, SHA256(MotDePasse), RndString(16, "0-9"), Encoding)
End Function

'----------------------------------------------------------------------------------------
Public Function AES_DéchiffrerChaine(Chaine As String, MotDePasse As String, Optional Encoding As Integer = Base64)
'----------------------------------------------------------------------------------------
' Déchiffre la chaîne passée en argument avec le mot de passe indiqué, et la renvoie.
'----------------------------------------------------------------------------------------
Dim i As Long
AES_DéchiffrerChaine = DecryptStringAES(Chaine, SHA256(MotDePasse), Encoding)
If Encoding = Base64 Then
i = InStr(1, AES_DéchiffrerChaine, Chr(0))
If i > 0 Then AES_DéchiffrerChaine = Left(AES_DéchiffrerChaine, i - 1)
End If
End Function

'----------------------------------------------------------------------------------------
Public Function AES_ChiffrerFichier(ByVal Fichier As String, MotDePasse As String) As Boolean
'----------------------------------------------------------------------------------------
' Chiffre le fichier passé en argument avec le mot de passe indiqué.
' Création d'un fichier chiffré avec l'extension ".AES".
' https://www.motobit.com/tips/detpg_read-write-binary-files/
'----------------------------------------------------------------------------------------
Dim V As Variant
Dim X As String, Chiffré As String
Dim i As Long
Dim oStream As Object

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

' Ouverture du fichier et lecture de son contenu binaire:
Set oStream = CreateObject("ADODB.Stream")
With oStream
.Type = 1
.Open
.LoadFromFile Fichier
V = .Read
.Close
End With

' Transforme le tout dans une variable texte:
X = Space(UBound(V) + 1)
For i = 0 To UBound(V)
Mid(X, i + 1, 1) = Chr(V(i))
Next i

' Chiffre le contenu du fichier:
Chiffré = AES_ChiffrerChaine(X, MotDePasse, 1)

' Ajoute la taille d'origine dans l'en-tête, suivi de "@" pour la retrouver au déchiffrement:
Chiffré = UBound(V) & "@" & Chiffré

' Création d'un fichier texte avec ajout de l'extension .AES:
Fichier = Fichier & ".AES"

' Convertion de la chaine en binaire:
Dim W() As Byte
W = StrConv(Chiffré, vbFromUnicode)

' Enregistrement du fichier binaire:
With oStream
.Open
.Type = 1
.Write W
.SaveToFile Fichier, 2 ' 1 = no overwrite, 2 = overwrite
.Close
End With

' Renvoie VRAI:
AES_ChiffrerFichier = True

' Gestion des erreurs:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Public Function AES_DéchiffrerFichier(ByVal Fichier As String, MotDePasse As String, _
Optional ByVal SaveTo As String = "", _
Optional SupprimeFichier As Boolean = False) As Boolean
'----------------------------------------------------------------------------------------
' Déchiffre le fichier passé en argument avec le mot de passe indiqué.
' Suppression du fichier chiffré avec l'extension ".AES".
' https://www.motobit.com/tips/detpg_read-write-binary-files/
'----------------------------------------------------------------------------------------
Dim X As String, R As Variant
Dim W() As Byte
Dim i As Long, Taille As Variant
Dim oStream As Object

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

' Ouverture du fichier et lecture de son contenu binaire:
Set oStream = CreateObject("ADODB.Stream")
With oStream
.Type = 1
.Open
.LoadFromFile Fichier
R = .Read
.Close
End With

' Transformation du binaire en chaine
X = StrConv(R, vbUnicode)

' Recherche la taille d'origine contenue dans l'en-tête du flux de données:
i = InStrRev(X, "@")
Taille = Left(X, i - 1)

' Ne conserve que la partie chiffrée:
X = Mid(X, i + 1)

' Déchiffre cette partie:
X = AES_DéchiffrerChaine(X, MotDePasse, 1)

' Convertion de la chaine en binaire:
W = StrConv(X, vbFromUnicode)
' Mais ne garde que les caractères de la taille d'origine:
ReDim Preserve W(0 To Taille)

' Préparation du fichier destination si non renseigné:
If SaveTo = "" Then SaveTo = Left(Fichier, Len(Fichier) - 4)

' Création d'un fichier binaire déchiffré:
With oStream
.Open
.Type = 1
.Write W
.SaveToFile SaveTo, 2  ' 1 = no overwrite, 2 = overwrite
.Close
End With

' Renvoie VRAI:
AES_DéchiffrerFichier = True

' Suppression du fichier chiffré (si demandé):
If SupprimeFichier = True Then Kill Fichier

' Gestion des erreurs:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
Err.Clear

End Function

'----------------------------------------------------------------------------------------
Private Function RndString(NbCar As Long, ParamArray ListeChoix() As Variant) As String
'----------------------------------------------------------------------------------------
' NbCar = nombre de caractères à générer.
' ListeChoix = liste des types de caractères (bornes mini et maxi), passés en caractères
'              ou en code ASCII.
'----------------------------------------------------------------------------------------
' Renvoie une chaîne de caractères aléatoires de NbCar éléments.
' RndString(1, "A-E") ' pour un caractère entre A et E.
' RndString(1, "65-69") ' pour un caractère entre A et E.
' RndString(1, "A-E", "G-J", "W-Z" ) ' pour un caractère entre A et E, ou entre G et J ou entre W et Z.
'----------------------------------------------------------------------------------------
Dim i As Long, DansListe As Integer, Tps As Variant

' Boucle sur le nombre de caractères à retourner:
For i = 1 To NbCar
' Prend une liste au hasard:
DansListe = RndInteger(LBound(ListeChoix), UBound(ListeChoix))
' Retrouve la borne mini et maxi de cette liste:
Tps = Split(ListeChoix(DansListe), "-")
' Prend un caractère au hasard dans cette borne:
RndString = RndString & RndChr(Tps(0), Tps(1))
Next i
End Function

'----------------------------------------------------------------------------------------
Private Function RndInteger(ByVal Mini As Long, ByVal Maxi As Long) As Long
'----------------------------------------------------------------------------------------
' Renvoie un nombre entier au hasard compris entre Mini et Maxi
'----------------------------------------------------------------------------------------
Randomize Timer
RndInteger = Int((Maxi - Mini + 1) * Rnd + Mini)
End Function

'----------------------------------------------------------------------------------------
Private Function RndChr(ByVal Mini As Variant, ByVal Maxi As Variant) As String
'----------------------------------------------------------------------------------------
' Mini = un code ASCII ou le caractère alpha.
' Maxi = un code ASCII ou le caractère alpha.
'----------------------------------------------------------------------------------------
' Renvoie un caractère compris entre les bornes mini et maxi.
'----------------------------------------------------------------------------------------
' Cas particulier des chiffres 0 à 9 qu'il ne faut pas confondre des valeurs :
If Mini Like "[0-9]" Then Mini = asc(Mini)
If Maxi Like "[0-9]" Then Maxi = asc(Maxi)
' Convertir en valeur Asc les arguments passés en String :
If Val(Mini) = 0 Then Mini = asc(Mini)
If Val(Maxi) = 0 Then Maxi = asc(Maxi)

RndChr = Chr(RndInteger(Mini, Maxi))
End Function

'----------------------------------------------------------------------------------------
Private Function EncryptStringAES(strText As String, strKey As String, StrIV As String, _
Optional Encoding As Integer = Base64) As Variant
'----------------------------------------------------------------------------------------

Dim objCSP As Object
Dim byteIV() As Byte
Dim byteText() As Byte
Dim byteEncrypted() As Byte
Dim byteEncryptedIV() As Byte
Dim strEncryptedIV As String

EncryptStringAES = Null

On Error GoTo FunctionError

Set objCSP = CreateObject("System.Security.Cryptography.RijndaelManaged")

' Check arguments
If strText = Null Or Len(strText) <= 0 Then Err.Raise vbObjectError + 513, "strText", "Argument 'strText' cannot be null"
If strKey = Null Or Len(strKey) <= 0 Then Err.Raise vbObjectError + 514, "strKey", "Argument 'strKey' cannot be null"
If StrIV = Null Or Len(StrIV) <= 0 Then Err.Raise vbObjectError + 515, "strIV", "Argument 'strIV' cannot be null"

' Encryption Settings:
objCSP.padding = Zeros
objCSP.Key = Base64toBytes(strKey) ' NOTE: Convert SHA256 hash to bytes
objCSP.IV = CreateObject("System.Text.UTF8Encoding").GetBytes_4(StrIV)

' Convert from string to bytes (strText and strIV)
byteText = CreateObject("System.Text.UTF8Encoding").GetBytes_4(strText)
byteIV = CreateObject("System.Text.UTF8Encoding").GetBytes_4(StrIV)

' Encrypt byte data
byteEncrypted = objCSP.CreateEncryptor().TransformFinalBlock(byteText, 0, UBound(byteText) + 1)

' Concatenate byteEncrypted and byteIV
Dim i As Long
byteEncryptedIV = byteIV
ReDim Preserve byteEncryptedIV(UBound(byteIV) + UBound(byteEncrypted) + 1)
For i = 0 To UBound(byteEncrypted)
byteEncryptedIV(i + UBound(byteIV) + 1) = byteEncrypted(i)
Next i

' Convert from bytes to encoded string
Select Case Encoding
Case Base64
strEncryptedIV = BytesToBase64(byteEncryptedIV)
Case Hex
strEncryptedIV = BytesToHex(byteEncryptedIV)
Case Else
Err.Raise vbObjectError + 516, "Encoding", "Invalid encoding type"
End Select

' Return IV and encrypted string
EncryptStringAES = strEncryptedIV 'BytesToBase64(byteIV) & strEncrypted

' Print encryption info for user
'Debug.Print GetCSPInfo(objCSP)

Set objCSP = Nothing

Exit Function

FunctionError:

'MsgBox "Error: AES encryption failed" & vbNewLine & Err.Description

End Function

'----------------------------------------------------------------------------------------
Private Function DecryptStringAES(strEncryptedIV As String, strKey As String, _
Optional Encoding As Integer = Base64) As Variant
'----------------------------------------------------------------------------------------

Dim objCSP As Object
Dim byteEncryptedIV() As Byte
Dim byteIV(0 To 15) As Byte
Dim StrIV As String

Dim byteEncrypted() As Byte
Dim byteText() As Byte
Dim strText As String

DecryptStringAES = Null

On Error GoTo FunctionError

Set objCSP = CreateObject("System.Security.Cryptography.RijndaelManaged")

' Convert from encoded string to bytes
Select Case Encoding
Case Base64
byteEncryptedIV = Base64toBytes(strEncryptedIV)
Case Hex
byteEncryptedIV = HextoBytes(strEncryptedIV)
Case Else
Err.Raise vbObjectError + 516, "Encoding", "ERROR: Invalid encoding type"
End Select

' Check arguments (Part 1)
If strEncryptedIV = Null Or Len(strEncryptedIV) <= 0 Then Err.Raise vbObjectError + 513, "strEncryptedIV", "Argument 'strEncryptedIV' cannot be null"
If strKey = Null Or Len(strKey) <= 0 Then Err.Raise vbObjectError + 514, "strKey", "Argument 'strKey' cannot be null"

' Extract IV from strEncrypted
Dim i As Long 'Integer
For i = LBound(byteIV) To UBound(byteIV)
byteIV(i) = byteEncryptedIV(i)
Next i
StrIV = CreateObject("System.Text.UTF8Encoding").GetString(byteIV)

' Check arguments (Part 2)
If StrIV = Null Or Len(StrIV) <= 0 Then Err.Raise vbObjectError + 515, "strIV", "Argument 'strIV' cannot be null"

' Extract encrypted text from strEncryptedIV
ReDim byteEncrypted(UBound(byteEncryptedIV) - UBound(byteIV) - 1)
For i = LBound(byteEncrypted) To UBound(byteEncrypted)
byteEncrypted(i) = byteEncryptedIV(UBound(byteIV) + i + 1)
'Debug.Print "i=" & i & vbTab & UBound(byteIV) + 1 + i
Next i

' Decryption Settings:
objCSP.padding = Zeros
objCSP.Key = Base64toBytes(strKey) ' NOTE: Convert SHA256 hash to bytes
objCSP.IV = byteIV 'CreateObject("System.Text.UTF8Encoding").GetBytes_4(strIV)

' Decrypt byte data
byteText = objCSP.CreateDecryptor().TransformFinalBlock(byteEncrypted, 0, UBound(byteEncrypted) + 1)

' Convert from bytes to string
strText = CreateObject("System.Text.UTF8Encoding").GetString(byteText)

' Return decrypted string
DecryptStringAES = strText

' Print decryption info for user
'Debug.Print GetCSPInfo(objCSP)

Set objCSP = Nothing

Exit Function

FunctionError:

'MsgBox "Error: AES decryption failed" & vbNewLine & Err.Description

End Function

'----------------------------------------------------------------------------------------
Private Function SHA256(strText As String) As String
'----------------------------------------------------------------------------------------

Dim objUTF8 As Object, objSHA256 As Object
Dim bytesText() As Byte, bytesHash() As Byte

Set objUTF8 = CreateObject("System.Text.UTF8Encoding")
Set objSHA256 = CreateObject("System.Security.Cryptography.SHA256Managed")

bytesText = objUTF8.GetBytes_4(strText)
bytesHash = objSHA256.ComputeHash_2((bytesText))

SHA256 = BytesToBase64(bytesHash)

Set objUTF8 = Nothing
Set objSHA256 = Nothing

End Function

'----------------------------------------------------------------------------------------
Private Function GetCSPInfo(objCSP As Object) As String
'----------------------------------------------------------------------------------------
'Display block size, key size, mode, and padding information

Dim strCipherMode As String, strPaddingMode As String

Select Case objCSP.Mode
Case CBC: strCipherMode = "Mode: Cipher Block Chaining (CBC)"
Case ECB: strCipherMode = "Mode: Electronic Codebook (ECB)"
Case OFB: strCipherMode = "Mode: Output Feedback (OFB)"
Case CFB: strCipherMode = "Mode: Cipher Feedback (CFB)"
Case CTS: strCipherMode = "Mode: Cipher Text Stealing (CTS)"
Case Else: strCipherMode = "Mode: Undefined"
End Select

Select Case objCSP.padding
Case None: strPaddingMode = "Padding: None"
Case PKCS7: strPaddingMode = "Padding: PKCS7"
Case Zeros: strPaddingMode = "Padding: Zeros"
Case ANSIX923: strPaddingMode = "Padding: ANSIX923"
Case ISO10126: strPaddingMode = "Padding: ISO10126"
Case Else: strPaddingMode = "Padding: Undefined"
End Select

GetCSPInfo = objCSP & vbNewLine & _
"Block Size: " & objCSP.BlockSize & " bits" & vbNewLine & _
"Key Size: " & objCSP.keySize & " bits" & vbNewLine & _
strCipherMode & vbNewLine & strPaddingMode

Set objCSP = Nothing

End Function

'----------------------------------------------------------------------------------------
Private Function GetDecryptStringIV(strEncryptedIV As String, Optional Encoding As Integer = Base64) As String
'----------------------------------------------------------------------------------------

Dim byteEncryptedIV() As Byte
Dim byteIV(0 To 15) As Byte
Dim StrIV As String

On Error GoTo FunctionError

' Convert from encoded string to bytes
Select Case Encoding
Case Base64
byteEncryptedIV = Base64toBytes(strEncryptedIV)
Case Hex
byteEncryptedIV = HextoBytes(strEncryptedIV)
Case Else
Err.Raise vbObjectError + 516, "Encoding", "ERROR: Invalid encoding type"
End Select

' Check arguments
If strEncryptedIV = Null Or Len(strEncryptedIV) <= 0 Then Err.Raise vbObjectError + 513, "strEncryptedIV", "Argument 'strEncryptedIV' cannot be null"

' Extract IV from strEncrypted
Dim i As Integer
For i = LBound(byteIV) To UBound(byteIV)
byteIV(i) = byteEncryptedIV(i)
Next i
StrIV = CreateObject("System.Text.UTF8Encoding").GetString(byteIV)

' Return IV
GetDecryptStringIV = StrIV

Exit Function

FunctionError:

MsgBox "Error: GetDecryptStringIV failed" & vbNewLine & Err.Description

End Function

'----------------------------------------------------------------------------------------
' Internal Base64 Conversion Functions
Private Function BytesToBase64(varBytes() As Byte) As String
With CreateObject("MSXML2.DomDocument").createElement("b64")
.DataType = "bin.base64"
.nodeTypedValue = varBytes
BytesToBase64 = Replace(.Text, vbLf, "")
End With
End Function

Private Function Base64toBytes(varStr As String) As Byte()
With CreateObject("MSXML2.DOMDocument").createElement("b64")
.DataType = "bin.base64"
.Text = varStr
Base64toBytes = .nodeTypedValue
End With
End Function

' Internal Hex Conversion Functions
Private Function BytesToHex(varBytes() As Byte) As String
With CreateObject("MSXML2.DomDocument").createElement("hex")
.DataType = "bin.hex"
.nodeTypedValue = varBytes
BytesToHex = Replace(.Text, vbLf, "")
End With
End Function

Private Function HextoBytes(varStr As String) As Byte()
With CreateObject("MSXML2.DOMDocument").createElement("hex")
.DataType = "bin.hex"
.Text = varStr
HextoBytes = .nodeTypedValue
End With
End Function
'------------------------------------------------------------------------------------------------

VII-O - TS_SolveurSomme

La fonction TS_SolveurSomme (que vous trouverez dans le module « TS_Solveur » du fichier joint) retrouve les nombres d'une colonne dont la somme est comprise entre un minimum et un maximum recherché.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée ;

- Mini : la valeur minimale que doit faire la somme des nombres ;

- Maxi : (facultatif) la valeur maximale que doit faire la somme des nombres. Si non reseignée alors reprend Mini ;

- NbMaxiSolutions : (facultatif) le nombre de solutions trouvées pour sortir par anticipation de la recherche ;

- DuréeMaxi : (facultatif) la durée maximale en secondes du traitement par recherche aléatoire ;

- Modale : (facultatif) indique si la fenêtre de restitution doit être modale ou non ;

- NbElement : (facultatif) si > 0 la solution doit contenir le nombre d'éléments indiqué (ni plus ni moins) ;

- AutantPlusMoins : (facultatif) si True la solution doit contenir autant de nombres négatifs que positifs.

La fonction renvoie : le nombre de solutions trouvées (ou 0 si rien de trouvé).

Exemple avec ce tableau issu du compte client où Alice doit retrouver les factures qui correspondent au virement de 165,02 euros qu'elle a reçu :

Il n'est pas évident de trouver les factures correspondantes au virement reçu de 165,02 euros

La fonction TS_SolveurSomme va être bien utile à Alice pour retrouver les factures qui correspondent au montant reçu afin de les « lettrer ».
Bob lui a préparé un programme où elle n'a qu'à saisir le montant recherché, sachant que le tableau structuré est nommé « Tableau_x » et la colonne concernée « Montant » :

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------------
Dim Mt As Double
Mt = Application.InputBox("Saisir le montant cherché :", "TS_SolveurSomme", Type:=1)
Call TS_SolveurSomme([Tableau_x], "Montant", Mt)

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

Après quelques secondes de traitement un formulaire affice la solution trouvée, soit les factures F001, F002, F007, F008, F014 et F016.

Un formulaire présente la solution trouvée

En cliquant sur la ligne du formulaire Alice filtre les factures concernées.

Les montants concernés sont filtrés et sélectionnés

Alice peut alors cliquer sur le bouton du formulaire « Garder ce filtre » pour le fermer et conserver le filtre posé ou cliquer sur le bouton « Annuler » pour restaurer la situation de départ.
Avec le montant reçu de 83,87 euros trois solutions sont possibles, comme nous pouvons le voir ci-dessous.

Cas où plusieurs solutions sont possibles

La première solution est constituée des factures F004, F008 et F013.
La deuxième des factures F001, F004, F011 et F016, mais attention le montant de la facture F001 de 12,66 euros est aussi le montant de la facture F007, qui constitue la troisième solution possible. Dans ce cas un message le signale en rouge dans le formulaire : « Attention, certains éléments sont repris plusieurs fois dans les possibilités proposées ».
Notez que seules les factures de la solution sélectionnée sont activées.

Remarques :
- L'algorithme de recherche analyse toutes les solutions possibles, soit 2^n possibiliées (où n est le nombre d'éléments). Avec un nombre réduit d'éléments le temps de traitement reste raisonnable. Mais passé 22 éléments (soit 4 194 304 tests) il faut opter pour une autre méthode : la recherche aléatoire de solutions. L'algorithme va alors piocher des élements au hasard pour trouver une solution, pendant une durée déterminée par l'argument "DuréeMaxi" de la fonction (10 secondes par défaut). Et curieusement ça marche pas trop mal. Le formulaire indiquera le nombre de solutions trouvées suivi de « il peut y en avoir d'autres ».
- Seuls les montants visibles (et non nuls) de la colonne source sont utilisés pour rechercher la somme désirée. Ce qui permet de poser un filtre pour ne garder que ceux à analyser avant de lancer la recherche.
- Par défaut le formulaire de restitution des solutions est en mode non modale, ce qui permet d'intervenir sur le classeur tout en laissant le formulaire actif. Cela peut être un avantage ou un inconvéniant suivant la situation. Passez l'argument "Modale" de la fonction à True si besoin.
- Ne cherchez pas dans le fichier joint le formulaire de restitution car il est généré automatiquement lors de la première utilisation de la fonction.
- Je ne donne pas ici le code de cette fonction, d'une part pour vous épargner la lecture de ses 700 lignes, d'autre part car elle mériterait une documentation spécifique pour en expliquer les subtilités.

VII-P - TS_LierMacroSurTitre

La fonction TS_LierMacroSurTitre lie un titre d’un tableau structuré à une macro de votre choix.
La souris prend la forme d’une main lorsqu’elle survole le titre pour signaler à l’utilisateur qu’une action est possible. Une infobulle peut contenir votre commentaire.
Un clic gauche sur le titre exécutera votre macro personnelle.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré ;

- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou 0, alors la dernière colonne du tableau est traitée ;

- Macro : (facultatif) le nom de la macro liée, par défaut TS_TrierSurTitre qui permet de trier les données d'après le titre en cliquant dessus. Si vide alors efface le lien ;

- Commentaire : le commentaire affiché lorsque le titre est pointé par la souris ;

- Soulignement : True pour souligner le titre, False pour ne pas le souligner.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour exécuter la macro personnelle AjouterUnNom lors d'un clic sur le titre « Nom Famille » du tableau « TS_Eleves » :

Call TS_LierMacroSurTitre([TS_Eleves], "Nom Famille", "AjouterUnNom", "Cliquez pour ajouter un nom", True)

Exemple d’appel pour trier le tableau « TS_Eleves » lors d'un clic sur le titre « Nom Famille » (la macro TS_TrierSurTitre est exécutée par défaut) :

Call TS_LierMacroSurTitre([TS_Eleves], "Nom Famille")

Idem mais en affichant un commentaire lorsque la souris survole le titre, et le souligner :

Call TS_LierMacroSurTitre([TS_Eleves], "Nom Famille", ,"Cliquez ici pour trier par ordre croissant ou décroissant", True)

La souris prend la forme d'une main quand elle survole un titre lié à une macro

Remarques :
Le lien est mémorisé lorsque vous enregistrez le classeur. Il n’est donc pas nécessaire dans votre code de le générer systématiquement.
Concrètement un rectangle translucide (objet Shapes) est créé dans la cellule du titre du tableau et c’est à cet objet qu’est liée la macro. Le rectangle est réduit en largeur à sa droite pour permettre l’affichage des éventuels boutons de filtre.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_LierMacroSurTitre(TS As Range, ByVal Colonne As Variant, _
Optional Macro As String = "TS_TrierSurTitre", _
Optional Commentaire As String = "", _
Optional Soulignement As Boolean = False) As Boolean
'------------------------------------------------------------------------------------------------
' lie une macro à un titre d'un tableau structuré.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors traite la dernière colonne du tableau.
' Macro : Le nom de la macro liée, par défaut "TS_TrierSurTitre" qui permet de trier les données
'         d'après le titre en cliquant dessus. Si vide alors efface le lien.
' Commentaire : Le commentaire affiché lorsque le titre est pointé par la souris.
' Soulignement : True pour souligner le titre, False pour ne pas le souligner.
'------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé ou False dans le cas contraire.
'------------------------------------------------------------------------------------------------
' Remarque : la feuille du tableau doit être active et la colonne concernée visible.
'------------------------------------------------------------------------------------------------
' Exemple d'appel pour trier le tableau TS_Eleves lors d'un clic sur le titre "Nom Famille":
' Call TS_LierMacroSurTitre([TS_Eleves], "Nom Famille")
' Idem mais en affichant un commentaire lorsque la souris survole le titre, et le souligner:
' Call TS_LierMacroSurTitre([TS_Eleves], "Nom Famille", ,"Cliquez ici pour trier par ordre croissant ou décroissant", True)
'------------------------------------------------------------------------------------------------
Dim Couleur As Long, AncIncludeFont As Boolean, AncXlHAlign As Long

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

' Force l'affichage de la feuille:
Sheets(TS.Parent.Name).Visible = True
Sheets(TS.Parent.Name).Activate

' Récupère les coordonnées de la cellule:
Dim x As Integer, y As Long
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
x = TS.Column + Colonne - 1
y = TS.Row - 1

' Force une taille de colonne non nulle:
Dim Largeur As Double
Largeur = TS.Columns(Colonne).ColumnWidth
Call TS_LargeurColonne(TS, Colonne, 0)
If TS.Columns(Colonne).ColumnWidth < Largeur Then Call TS_LargeurColonne(TS, Colonne, Largeur)

' Le caractère @ est réservé (un titre avec ce caractère fait planter le tri):
If InStr(1, Cells(y, x), "@") > 0 Then Err.Raise vbObjectError, , "Le titre ne doit pas avoir le caractère réservé @"

' Efface les anciens objets de la cellule:
Dim Sh As Object
For Each Sh In ActiveSheet.Shapes
If Sh.TopLeftCell.Column = x And Sh.TopLeftCell.Row = y Then Sh.Delete
Next Sh

' Création d'un objet sur la cellule (un rectangle vide) où est indiquée la macro liée:
If Macro <> "" Then
ActiveSheet.Shapes.AddShape(msoShapeRectangle, Cells(y, x).Left + 3, Cells(y, x).Top + 1, Cells(y, x).Width - 20, Cells(y, x).Height - 2).Select
Selection.Name = TS.ListObject.Name & "@" & TS.ListObject.ListColumns(Colonne).Name
Selection.ShapeRange.Fill.Visible = msoFalse
Selection.ShapeRange.Line.Visible = msoFalse
Selection.OnAction = Macro
End If

' Sélectionne le titre:
TS.ListObject.HeaderRowRange(Colonne).Select

' Restaure la colonne:
TS.Columns(Colonne).ColumnWidth = Largeur

' S'il faut ajouter un commentaire:
If Commentaire <> "" Then
' Mémorise la couleur (visible) de la cellule:
Couleur = ActiveCell.DisplayFormat.Font.Color
' Mémorise si l'ajout d'un lien hypertexte force ou non le format par défaut pour les liens:
AncIncludeFont = ActiveWorkbook.Styles("Hyperlink").IncludeFont
' Ne pas appliquer le format par défaut de la police pour un lien:
' https://excel-downloads.com/threads/changer-la-couleur-des-hyperliens.230291/
ActiveWorkbook.Styles("Hyperlink").IncludeFont = False
' Pose le commentaire via un lien hypertexte:
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", ScreenTip:=Commentaire
' Restaure la couleur et la configuration d'origine:
ActiveCell.Font.Color = Couleur
ActiveWorkbook.Styles("Hyperlink").IncludeFont = AncIncludeFont
Else ' Ou s'il faut supprimer celui qui existe:
If ActiveCell.Hyperlinks.Count = 1 Then
AncXlHAlign = Selection.HorizontalAlignment
Couleur = ActiveCell.DisplayFormat.Font.Color
Selection.Hyperlinks.Delete
Selection.HorizontalAlignment = AncXlHAlign
ActiveCell.Font.Color = Couleur
End If
End If

' Souligne:
Selection.Font.Underline = IIf(Soulignement = True, xlUnderlineStyleSingle, xlUnderlineStyleNone)

' Renvoie Vrai:
TS_LierMacroSurTitre = True

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_LierMacroSurTitre", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_LierMacroSurTitre"
End If
Err.Clear

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

La macro TS_TrierSurTitre trie par ordre croissant le tableau structuré d’après le titre qui la lance, ou inverse l’ordre de tri s’il est déjà trié.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Private Sub TS_TrierSurTitre()
'------------------------------------------------------------------------------------------------
Dim TS As Range
Dim Colonne As Integer, i As Integer
Dim AncShowAutoFilterDropDown As Boolean

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

' Récupère le tableau structuré du titre:
Set TS = Range(Split(Application.Caller, "@")(0))

Colonne = TS_IndexColonne(TS, Split(Application.Caller, "@")(1))
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

' Mémorise l'apparence du bouton de filtre:
AncShowAutoFilterDropDown = TS.ListObject.ShowAutoFilterDropDown

' Recherche si la colonne est déjà triée pour inverser l'ordre du tri:
For i = 1 To TS.ListObject.Sort.SortFields.Count
If TS.ListObject.Sort.SortFields(i).Key.Column - TS.Column + 1 = Colonne Then
If TS.ListObject.Sort.SortFields(i).Order = xlAscending Then
Call TS_TrierUneColonne(TS, Colonne, xlSortOnValues, xlDescending, True)
Else
Call TS_TrierUneColonne(TS, Colonne, xlSortOnValues, xlAscending, True)
End If
Exit For
End If
Next i

' Si elle n'est pas triée alors trie par ordre croissant:
If i > TS.ListObject.Sort.SortFields.Count Then Call TS_TrierUneColonne(TS, Colonne, xlSortOnValues, xlAscending, True)

' Restaure l'apparence du bouton de filtre:
TS.ListObject.ShowAutoFilterDropDown = AncShowAutoFilterDropDown

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_TrierSurTitre", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_TrierSurTitre"
End If
Err.Clear

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

VII-Q - TS_FiltrerColonneActive

La fonction TS_FiltrerColonneActive filtre la colonne d'un tableau structuré d'après la cellule active. Ou inversement ôte le filtre si la colonne est filtrée.
Cette fonction sera appelée par un événement de type BeforeDoubleClick ou BeforeRightClick, voir l'exemple.

Ses arguments sont :

- Target : la cellule active ;

- CouleurSiFiltrée : (facultatif) la couleur de fond du titre si la colonne est filtrée (rouge par défaut) ;

- CouleurNonFiltrée : (facultatif) la couleur de fond du titre si la colonne n’est plus filtrée (transparent par défaut) ;

- LimiterTitres : (facultatif) liste des titres concernés sous forme d'un Array (c'est-à-dire entre guillemets et séparés par une virgule), ou vide si tous les titres du tableau sont concernés (valeur par défaut). Si la limitation ne porte que sur un titre vous pouvez passer un String.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple d’appel sur un clic droit de la souris, code à placer dans la feuille où est le tableau structuré :

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If TS_FiltrerColonneActive(Target) = True Then Cancel = True
End Sub
'------------------------------------------------------------------------------------------------

Un clic droit sur la cellule active filtre la colonne

Exemple pour restreindre le traitement aux colonnes "Nom Famille" et "Prénom" :

If TS_FiltrerColonneActive(Target, , , Array("Nom Famille", "Prénom")) = True Then Cancel = True

Exemple pour restreindre le traitement uniquement à la colonnes "Nom Famille" :

If TS_FiltrerColonneActive(Target, , , "Nom Famille") = True Then Cancel = True

Remarque : si CouleurNonFiltrée = CouleurSiFiltrée alors pose automatiquement les boutons de filtre quand la colonne est filtrée, sans quoi il ne serait plus possible de visualiser que la colonne est filtrée.
Cancel = TS_FiltrerColonneActive(Target, xlNone, xlNone, Array("Nom Famille", "Prénom"))

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_FiltrerColonneActive(ByVal Target As Range, _
Optional CouleurSiFiltrée As Long = vbRed, _
Optional CouleurNonFiltrée As Long = xlNone, _
Optional ByVal LimiterTitres As Variant = "") As Boolean
'------------------------------------------------------------------------------------------------
' Filtre la colonne d'un tableau structuré d'après la cellule active. Ou ôte le filtre si
' la colonne est filtrée. Cette fonction sera appelée par un événement de type "BeforeDoubleClick"
' ou "BeforeRightClick", voir l'exemple.
'------------------------------------------------------------------------------------------------
' Target : La cellule active.
' CouleurSiFiltrée : La couleur de fond du titre si la colonne est filtrée.
' CouleurNonFiltrée : La couleur de fond du titre si la colonne n'est plus filtrée.
' LimiterTitres : Liste des titres concernés sous forme d'un Array (c'est-à-dire entre guillemets,
'                 et séparés par une virgule), ou vide si tous les titres du tableau sont concernés.
'                 Si la limitation ne porte que sur un titre vous pouvez passer un String.
'------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé ou False dans le cas contraire.
'------------------------------------------------------------------------------------------------
' Exemple d'appel sur un clic droit de la souris:
' Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
' If TS_FiltrerColonneActive(Target) = True Then Cancel = True
' End Sub
'------------------------------------------------------------------------------------------------
' Autres exemples :
' Pour restreindre le traitement aux colonnes "Nom Famille" et "Prénom" :
' If TS_FiltrerColonneActive(Target, , , Array("Nom Famille", "Prénom")) = True Then Cancel = True
' Pour restreindre le traitement uniquement à la colonnes "Nom Famille" :
' If TS_FiltrerColonneActive(Target, , , "Nom Famille") = True Then Cancel = True
'------------------------------------------------------------------------------------------------
' Remarque : Si CouleurNonFiltrée = CouleurSiFiltrée alors pose automatiquement les boutons de filtre
'            quand la colonne est filtrée.
'            Cancel = TS_FiltrerColonneActive(Target, xlNone, xlNone, Array("Nom Famille", "Prénom"))
'------------------------------------------------------------------------------------------------
Dim TS As Range, Colonne As Long, Largeur As Double
Dim AncScreenUpdating As Boolean

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

' Si la cellule (active) est dans un tableau structuré:
If Not Target.ListObject Is Nothing Then
' Pointe sur ce tableau:
Set TS = Range(Target.ListObject)
' Récupère la colonne concernée:
Colonne = Target.Column - TS.Column + 1
' Si la colonne est dans la liste des titres autorisés ou si aucune restriction:
If IsArray(LimiterTitres) = False Then LimiterTitres = Array(LimiterTitres)
If UBound(Filter(LimiterTitres, TS.ListObject.ListColumns(Colonne).Name, True, vbTextCompare)) > -1 _
Or LimiterTitres(0) = "" Then
' Si ce n'est pas une ligne de titre:
If Target.Row >= TS.Row Then
' Si un filtre existe alors l'effacer:
Application.ScreenUpdating = False
If TS_Filtres_Existe(TS, Colonne) = True Then
Call TS_Filtres_Effacer(TS, Colonne)
' Pose la couleur pour signaler que la colonne n'est plus filtrée:
TS.ListObject.HeaderRowRange(1, Colonne).Interior.Color = CouleurNonFiltrée
Else ' Sinon, mémorise la largeur de la colonne:
Largeur = TS.Columns(Colonne).ColumnWidth
' La met à sa valeur optimale pour que tout soit affiché:
TS.Columns(Colonne).EntireColumn.AutoFit
' Pose un filtre sur le texte de la cellule active et non pas
' sa valeur pour la gestion des nombres et des dates:
Call TS_Filtres_Poser(TS, Colonne, Target.Text)
' Restaure la taille d'origine de la colonne:
TS.Columns(Colonne).ColumnWidth = Largeur
' Pose la couleur pour signaler que la colonne est filtrée:
TS.ListObject.HeaderRowRange(1, Colonne).Interior.Color = CouleurSiFiltrée
' Si CouleurNonFiltrée = CouleurSiFiltrée alors pose les boutons de filtre:
If CouleurNonFiltrée = CouleurSiFiltrée Then
TS.ListObject.ShowHeaders = True
TS.ListObject.ShowAutoFilterDropDown = True
End If
End If
' Renvoie Vrai:
TS_FiltrerColonneActive = True
End If
End If
End If

' Fin du traitement:
Gest_Err:
Application.ScreenUpdating = AncScreenUpdating
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_FiltrerColonneActive", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_FiltrerColonneActive"
End If
Err.Clear

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

VIII - Conclusion

Sur le forum d’entraide Excel de Developpez.com de plus en plus souvent les intervenants suggèrent d’utiliser un tableau structuré pour simplifier la gestion des données : ainsi le problème récurrent de recherche de la fin d’une plage… n’en est plus un.

Les tableaux structurés se démocratisent, et c’est tant mieux.

Pierre Fauconnier y a contribué avec son tutoriel cité en introduction destiné aux utilisateurs.

Je souhaitais y contribuer également avec cette documentation destinée aux développeurs en leur apportant des fonctions prêtes à l’emploi afin qu’ils puissent affronter les tableaux structurés en toute simplicité.

Et aussi en profiter pour démocratiser l’utilisation des requêtes SQL en VBA pour les tableaux structurés qui permettent de répondre rapidement à des besoins parfois complexes.

Je laisse les plus curieux d’entre vous découvrir en annexe 1 des exemples qui utilisent les requêtes SQL et devraient vous convaincre plus que de longs discours.

Mais pour faire des traitements corrects encore faut-il que les données soient correctes : l'annexe 3 vous donnera une astuce pour contrôler la validation des saisies.

Vous retrouverez toutes les fonctions étudiées dans le fichier joint « Tableau-Structure.xlsm » regroupées dans le module « TS ».

Bonne programmation.
Laurent OTT.
2022.

IX - Remerciements

Je remercie escartefigue pour la correction orthographique.

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

Je dédicace cette documentation à Claude Leloup.
Je le remercie pour ses nombreuses contributions en tant que correcteur orthographique sur le site de developpez.com et aussi pour m’avoir donné des ailes…

Note : de nombreux ajouts ont été réalisés après la première publication de cette documentation sans avoir été soumis à une relecture technique et orthographique, si vous constatez des erreurs merci de les signaler dans cette discussion ou par messagerie privée.

Le but ici étant de répondre aux besoins des développeurs, n'hésitez pas à proposer de nouvelles fonctions.

X - Le fichier joint

Vous trouverez le fichier Tableaux-Structures.xlsm qui contient les fonctions étudiées dans cette documentation regroupées dans le module « TS » facilement exportable dans vos applications par un simple « glisser/copier » depuis l’explorateur de projet VBA.
Le module « TS_AES_Rijndael » reprend les fonctions de chiffrement et déchiffrement détaillées au chapitre VII-N, et d'autres surprises.
Le module « TS_Solveur » reprend la fonction détaillée au chapitre VII-O.

Pour simplifier la saisie de votre code, pensez à utiliser la notation pointée « TS. » qui affiche l’ensemble des fonctions du module :

Pour utiliser les codes présentés dans cette documentation vous devrez installer les références suivantes dans votre projet :
- Microsoft Office 16.0 Object Library
- Microsoft Forms 2.0 Object Library

XI - Exemples d'utilisation de fonctions

Vous trouverez ci-dessous des exemples d'utilisation de quelques fonctions TS que nous avons étudiées dans cette documentation pour réaliser deux exercices à partir d'une liste d'élèves enregistrés dans le tableau structuré nommé « TS_Eleves ».
Le premier exercice consiste à générer une liste sans doublon des noms des élèves pour renseigner le tableau structuré « TS_Liste_Noms ».
Dans le second exercice nous ferons l'inverse pour alimenter le tableau structuré « TS_Fratries » des fratries, c'est-à-dire des noms en doublons, pour renseigner le nom de famille, le nombre d'enfants, la note moyenne, minimum et maximum de la fratrie.

Cette image représente le tableau source « TS_Eleves », le tableau des valeurs uniques « TS_Liste_Noms » et le tableau des fratries « TS_Fratries ».

XI-A - Alimenter un tableau d'une liste sans doublon

Il y a plusieurs façons de faire pour alimenter un tableau d'une liste sans doublon.
Nous allons en présenter cinq.
Pour vous faciliter la lecture du code j'ai nommé les arguments de certaines fonctions.

1) Alimenter un tableau d'une liste sans doublon en utilisant les boucles.
Principe : On boucle sur la source pour alimenter la destination de l'ensemble des noms, puis on supprime les doublons et l'on trie les noms restants par ordre croissant.

'------------------------------------------------------------------------------------------------
Sub Exemple()
'---------------------------------------------------------------------------------------
Dim i As Long, Nom As String

' Supprime les lignes de la destination pour avoir un tableau de destination vierge:
Call TS_SupprimerPlusieursLignes(Range("TS_Liste_Noms"), 1, 0)

' Boucle sur les lignes de la source:
For i = 1 To TS_Nombre_Lignes(Range("TS_Eleves"))
' Mémorise le nom de famille:
Nom = TS_InfoCellule(Range("TS_Eleves"), "Nom Famille", i)
' Ajoute une ligne à la destination:
Call TS_AjouterUneLigne(Range("TS_Liste_Noms"))
' Place dans cette ligne le nom mémorisé
Call TS_ModifCellule(Range("TS_Liste_Noms"), 1, i, Nom)
Next i

' Supprime les doublons:
Call TS_SupprimerDoublons(Range("TS_Liste_Noms"), 1)

' Trie dans l'ordre croissant le résultat:
Call TS_TrierUneColonne(Range("TS_Liste_Noms"), 1)

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

2) Alimenter un tableau d'une liste sans doublon en utilisant la fonction TS_ValeurUnique.
Principe : On mémorise dans une variable la liste des noms sans doublon et classés par ordre croissant obtenue par la fonction TS_ValeurUnique, puis on alimente le tableau destination des données.

'------------------------------------------------------------------------------------------------
Sub Exemple()
'---------------------------------------------------------------------------------------
Dim i As Long, Noms As Variant

' Supprime les lignes de la destination pour avoir un tableau de destination vierge:
Call TS_SupprimerPlusieursLignes(Range("TS_Liste_Noms"), 1, 0)

' Renvoie la liste des noms sans doublon et classés par ordre croissant:
Noms = TS_ValeurUnique(Range("TS_Eleves"), "Nom Famille")

' Alimente le tableau de la liste obtenue:
For i = 0 To UBound(Noms)
Call TS_AjouterUneLigne(Range("TS_Liste_Noms"))
Call TS_ModifCellule(Range("TS_Liste_Noms"), 1, 0, Noms(i))
Next i

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

3) Alimenter un tableau d'une liste sans doublon en utilisant la fonction TS_CopierUneColonne.
Principe : On copie la colonne des noms de famille dans le tableau destination par la fonction TS_CopierUneColonne, puis on supprime les doublons et l'on trie les noms restants par ordre croissant.

'------------------------------------------------------------------------------------------------
Sub Exemple()
'---------------------------------------------------------------------------------------
' Il faut effacer les filtres de la source car TS_CopierUneColonne ne copie que les lignes visibles:
Call TS_Filtres_Effacer(Range("TS_Eleves"))

' Efface les données de la destination et supprime les lignes sauf la première pour
' avoir un tableau de destination vide:
Call TS_EffacerToutesLignes(Range("TS_Liste_Noms"))
Call TS_SupprimerPlusieursLignes(Range("TS_Liste_Noms"), 2, 0)

' Copie les lignes visibles de la colonne source et les colle dans la destination:
Call TS_CopierUneColonne(TS_Source:=Range("TS_Eleves"), Colonne_Source:="Nom Famille", _
TS_Dest:=Range("TS_Liste_Noms"), Colonne_Dest:=1, Ligne_Dest:=1, _
Méthode:=xlCellTypeVisible)

' Sélectionne la première ligne car TS_CopierUneColonne a sélectionné toutes les lignes:
Call TS_Sélectionner(Range("TS_Liste_Noms"), 1, 1)

' Supprime les doublons:
Call TS_SupprimerDoublons(Range("TS_Liste_Noms"), 1)

' Trie dans l'ordre croissant le résultat:
Call TS_TrierUneColonne(Range("TS_Liste_Noms"), 1)

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

4) Alimenter un tableau d'une liste sans doublon en utilisant les fonctions TS_Range et TS_CopierUnTableau.
Principe : normalement la fonction TS_CopierUnTableau copie l'intégralité d'un tableau source dans un tableau destination, dans la limite des colonnes disponibles. Dans notre cas la première colonne serait copiée et l'on retrouverait les noms de famille dans le tableau « TS_Liste_Noms ». Sauf si l'utilisateur a modifié l'ordre de présentation des colonnes. Donc par sécurité nous mémorisons la colonne des noms de famille dans une variable par la fonction TS_Range et nous utilisons cette variable à la place d'un tableau. Puis on supprime les doublons et l'on trie les noms restants par ordre croissant. Vous remarquerez que le tableau destination n'a pas besoin d'être préalablement vidé car l'option TS_RemplacerDonnées s'en charge.

'------------------------------------------------------------------------------------------------
Sub Exemple()
'---------------------------------------------------------------------------------------
Dim V As Variant

' Mémorise dans une variable de type variant les données même masquées de la colonne du tableau source:
V = TS_Range(TS:=Range("TS_Eleves"), VisibleUniquement:=False, Colonne:="Nom Famille", Ligne:="")

' Colle la source, donc la variable V, dans la destination:
Call TS_CopierUnTableau(TS_Source:=V, TS_Dest:=Range("TS_Liste_Noms"), _
Méthode:=TS_RemplacerDonnées, _
ValeursOuFormules:=TS_Valeurs)
' Supprime les doublons:
Call TS_SupprimerDoublons(Range("TS_Liste_Noms"), 1)

' Trie dans l'ordre croissant le résultat:
Call TS_TrierUneColonne(Range("TS_Liste_Noms"), 1)

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

5) Alimenter un tableau d'une liste sans doublon en utilisant la fonction TS_RequeteSQL.
Principe : On utilise une requête SQL pour sélectionner les données source, les grouper en valeur unique, les trier par ordre croissant et alimenter le tableau destination.

'------------------------------------------------------------------------------------------------
Sub Exemple()
'---------------------------------------------------------------------------------------
Call TS_RequeteSQL(TS:=Range("TS_Eleves"), _
StrChamps:="[Nom Famille]", _
StrSQL:="GROUP BY [Nom Famille] ORDER BY [Nom Famille]", _
TS_Dest:=Range("TS_Liste_Noms"), _
Méthode:=TS_RemplacerDonnées)
End Sub
'-----------------------------------------------------------------------------------------------

XI-B - Alimenter le tableau structuré « TS_Fratries » des fratries

Rappel de l'exercice : alimenter le tableau structuré « TS_Fratries » pour renseigner le nom de famille, le nombre d'enfants, la note moyenne, minimale et maximale de chaque fratrie.

J'avoue ne pas avoir cherché à faire cela avec des boucles, des comparaisons et autres complications en tout genre car une requête SQL fait le travail tout naturellement (mais pour vous amuser vous pouvez faire plus compliqué).

Quelques explications sur cette requête :

- TS : Range("TS_Eleves") est le tableau structuré source ;

- StrChamps : est la sélection des données source. En plus du nom de famille nous avons Count pour compter les noms de famille, AVG pour la moyenne des notes, MIN pour la note minimale, MAX pour la note maximale ;

- StrSQL : la requête regroupe les noms de famille pour avoir des valeurs uniques GROUP BY [Nom Famille], compte les noms de famille et ne retient que ceux qui sont supérieurs à un HAVING Count([Nom Famille]) > 1 et les trie ORDER BY [Nom Famille] ;

- TS_Dest : Range("TS_Fratries") est le tableau structuré destination ;

- Méthode : TS_RemplacerDonnées indique qu'il faut vider la destination avant d'y poser les données.

La requête renvoie - 1 s'il y a une erreur, ou s'il n'y a aucun enregistrement sélectionné, c'est-à-dire aucune fratrie dans les données sources. Un message l'affiche.
Une boucle sur les colonnes permet de mettre en forme les données pour centrer horizontalement les en-têtes et la colonne nombre.

'------------------------------------------------------------------------------------------------
Sub Exemple()
'---------------------------------------------------------------------------------------
If TS_RequeteSQL(TS:=Range("TS_Eleves"), _
StrChamps:="[Nom Famille], Count([Nom Famille]), AVG([Note]), MIN([Note]), MAX([Note])", _
StrSQL:="GROUP BY [Nom Famille] HAVING Count([Nom Famille]) > 1 ORDER BY [Nom Famille]", _
TS_Dest:=Range("TS_Fratries"), _
Méthode:=TS_RemplacerDonnées) = -1 Then
' Si rien n'est trouvé:
MsgBox "Aucune fratrie trouvée."
End If

' Pour chaque colonne: Centre les titres, met les données au format standard sauf la colonne Nombre à centrer:
Dim i As Integer
For i = 1 To TS_Nombre_Colonnes(Range("TS_Fratries"))
Call TS_Aligner(Range("TS_Fratries"), i, xlHAlignCenter, xlVAlignCenter, TS_Aligner_Entete)
Call TS_Aligner(Range("TS_Fratries"), i, xlHAlignGeneral, xlVAlignCenter, TS_Aligner_Données)
Next i
Call TS_Aligner(Range("TS_Fratries"), "Nombre", xlHAlignCenter)

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

XII - Annexe 1 – Les requêtes SQL en VBA sur les tableaux structurés

XII-A - Présentation des requêtes SQL

Pour rechercher, synthétiser, regrouper, trier, mettre à jour des données dans un tableau structuré, j'utilise les requêtes SQL : vous allez constater dans les lignes qui suivent que c'est très simple et très pratique…

Seule restriction : pour faire des mises à jour avec la commande UPDATE le classeur ne doit pas être en lecture seule.

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 notre cas 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 colonnes à sélectionner (entre crochets si leur nom contient un espace), en les séparant par une virgule (l'ordre est libre). Un exemple :
SELECT Nom, Prénom, Note, [Date épreuve] FROM…
Ou plus simplement, une étoile permet de sélectionner directement toutes les colonnes :
SELECT * FROM… (attention, le SELECT * n’est pas recommandé, car sensible aux modifications de la table et contre performant)

Pour simplifier cela, notre fonction générique se contentera des noms des colonnes passés en argument.

- FROM « nom de la table » : pour 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. Pour simplifier cela, notre fonction générique se contentera du tableau structuré passé en argument et déterminera automatiquement le « nom de la table » (voir plus bas pour le cas des tableaux structurés de plus de 65 535 lignes ou de plus de 255 colonnes).

- WHERE « conditions » : facultatif, 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. Si la donnée comporte un simple quote il convient de le doubler. Par exemple :
WHERE [Département] = 'Val d''Oise'
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 sur plusieurs colonnes 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.

XII-B - TS_RequeteSQL

La fonction TS_RequeteSQL exécute une requête SQL sur un tableau structuré
Par défaut elle renvoie un jeu d’enregistrements mais si un tableau destination est renseigné dans les arguments alors elle alimente ce tableau et renvoie le nombre de lignes ajoutées.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré (s'il fait plus de 65 535 lignes ou 255 colonnes alors le tableau devra être unique sur la feuille sans quoi il y a un risque que la requête ne sélectionne pas les bonnes données) ;

- StrChamps : (facultatif) le nom des champs à sélectionner (ceux qui alimenteront le jeu d’enregistrements) ou vide pour tout prendre ;

- StrSQL : (facultatif) la requête SQL (qui sera automatiquement préfixée SELECT) avec ses conditions (si "!" alors la requête SQL passée dans l'argument StrSQL est exécutée) ;

- TS_Dest : (facultatif) le tableau structuré destination où afficher les données (en valeur) de la requête ;

- Méthode : (facultatif) indique si les données importées doivent remplacer celles existantes dans le tableau structuré de destination ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles (valeur par défaut),
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.

Si TS_Dest n'est pas renseigné la fonction renvoie un jeu d’enregistrements, ou Nothing si la requête ne sélectionne rien.
Si TS_Dest est renseigné la fonction renvoie le nombre de lignes ajoutées au tableau destination ou -1 si erreur.

Reprenons l’exemple d’exportation pour obtenir la liste sans doublon des noms de famille des élèves du tableau structuré « TS_Eleves ».
La liste classée par ordre alphabétique sera restituée dans un tableau structuré nommé « Tableau_Noms » existant déjà sur la feuille 2 mais dont l'étendue est limitée à la feuille (il faut donc indiquer la feuille concernée) :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim TS_Destination As Range

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

' Initialisation du tableau structuré :
Set TS_Destination = ThisWorkbook.Sheets("Feuil2").Range("Tableau_Noms")

' Requête pour obtenir la liste des noms sans doublon et triée et les afficher en remplacement des données :
Call TS_RequeteSQL(Range("TS_Eleves"), "[Nom]", "GROUP BY [Nom] ORDER BY [Nom]", TS_Destination, TS_RemplacerDonnées)

' Gestion des erreurs :
Gest_Err:
If Err.Number <> 0 Then MsgBox Err.Number & " : " & Err.Description, vbCritical, Err.Source

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

Remarque : l’instruction SQL "GROUP BY [Nom] ORDER BY [Nom]" regroupe les noms sans doublon et les trie par ordre croissant.

Exemple pour obtenir la liste des trois meilleures notes et le nom et prénom des élèves concernés :

'------------------------------------------------------------------------------------------------
...

' Requête pour obtenir les élèves qui ont eu les 3 meilleures notes, classées par notes :
Call TS_RequeteSQL(Tableau, "TOP 3 [Nom],[Prénom],[Note]", "WHERE [Note] > 10 ORDER BY [Note] DESC", TS_Destination, TS_RemplacerDonnées)

...
'------------------------------------------------------------------------------------------------

Remarques :

- l’instruction SQL "TOP 3 [Nom],[Prénom],[Note]" sélectionne les champs désirés et ne retient que les trois premiers enregistrements (et les égalités) du critère de sélection ;

- l’instruction SQL "WHERE [Note]>10 ORDER BY [Note] DESC" ne retient que les notes supérieures à 10 et les classe par ordre décroissant ;

- dans cet exemple les trois meilleures notes sont 18, 15 et 14 et deux élèves ont eu 14, donc ils sont repris tous les deux.

Exemple pour regrouper les notes par ordre décroissant et indiquer le nombre d’élèves concernés :

'------------------------------------------------------------------------------------------------
...

' Requête pour obtenir la liste des notes et la quantité d'élèves ayant eu cette note :
Call TS_RequeteSQL(Tableau, "[Note], Count([Note])", "GROUP BY [Note] ORDER BY [Note] DESC", TS_Destination, TS_RemplacerDonnées))

' Place des totaux :
Call TS_ModifCellule(TS_Destination, "Note", -1, "Nb élèves :", TS_Valeur)
Call TS_DéfinirTotaux(TS_Destination, "Quantité", xlTotalsCalculationSum)

...
'------------------------------------------------------------------------------------------------

Remarques :

- l’instruction SQL "[Note], Count([Note])" sélectionne les notes et leur nombre ;
- AVG : calcule la moyenne,
- SUM : calcule la somme,
- COUNT : compte le nombre d'éléments,
- MIM : renvoie la valeur la plus petite,
- MAX : renvoie la valeur la plus grande ;

- l’instruction SQL "GROUP BY [Note] ORDER BY [Note] DESC" regroupe les notes et les trie par ordre décroissant.

Exemple pour ajouter 1 aux notes inférieures à 10 :

'------------------------------------------------------------------------------------------------
...

' Requête pour obtenir les notes inférieures à 10 :
Set Enr = TS_RequeteSQL(Tableau, "[Note]", "WHERE [Note] < 10")

' Boucle sur le jeu d’enregistrements pour ajouter 1 à la note :
If Not Enr Is Nothing Then
While Enr.EOF = False
Enr.Fields(0).Value = Enr.Fields(0).Value + 1 ' Ajoute 1 à la valeur.
Enr.Update                                    ' Valide la modification.
Enr.MoveNext                                  ' Passe à l'enregistrement suivant.
Wend
End If

...
'------------------------------------------------------------------------------------------------

Remarques :

- le premier champ de la sélection est contenu dans Fields(0), le suivant (s’il y en a un dans la requête) en Fields(1) et ainsi de suite ;

- n’oubliez pas l’instruction Update pour valider la modification faite à un enregistrement.

Attention : pour exécuter une mise à jour des données avec l’instruction Update le classeur ne doit pas être en lecture seule.

Ne sont présentés ici que quelques exemples des capacités qu’offrent les requêtes SQL et qui évitent bien souvent de laborieuses lignes de code en VBA.

Vous imaginez que le SQL dispose de critères de sélections plus complets, par exemple :

- le mot clé IN permet de sélectionner des éléments parmi une liste de valeurs, soit la syntaxe suivante WHERE « nom de colonne » IN ('valeur1', 'valeur2', 'valeur3'…) ;

- le mot clé Like permet de sélectionner des chaînes de caractères en disposant des jokers :
WHERE Nom Like 'T%' renvoie les noms commençants par « T ».
WHERE Nom Like '%TOTO%' renvoie les noms qui contiennent « TOTO ».

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_RequeteSQL(TS As Range, StrChamps As String, _
Optional ByVal StrSQL As String = "", _
Optional TS_Dest As Range, _
Optional Méthode As Enum_CopierDonnées = TS_RemplacerDonnées) As Variant
'------------------------------------------------------------------------------------------------
' Sélectionne les données d'un tableau de données EXCEL (ou une plage avec en-tête)
' et alimente TS_RequeteSQL des enregistrements correspondants à la requête.
' TS : La plage du Tableau Structuré (si > 65535 lignes ou > 255 colonnes alors les champs doivent être
' uniques sur la feuille sinon il y a un risque de se tromper de tableau).
' StrChamps : (facultatif) Liste des champs (ou * ou vide pour tous).
'             Si "!" alors la requête SQL passée dans l'argument StrSQL est exécutée.
' StrSQL : (facultatif) Requête SQL (qui sera automatiquement préfixée SELECT) avec ses conditions.
' TS_Dest : (facultatif) Le tableau structuré destination où afficher les données de la requête (en valeur).
' Méthode : (facultatif) énumération Enum_CopierDonnées =
'           TS_RemplacerDonnées : remplace les données existantes par les nouvelles (valeur par défaut).
'           TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
'------------------------------------------------------------------------------------------------
' Renvoie : Si TS_Dest n'est pas renseigné : Le jeu d'enregistrements, ou Nothing si rien n'est sélectionné (ou erreur).
'           Si TS_Dest est renseigné : le nombre de lignes ajoutées au tableau destination ou -1 si erreur.
'------------------------------------------------------------------------------------------------
' Remarques si TS_Dest est renseigné :
' - Si le tableau destination à plus de colonnes que la requête: les colonnes en surplus sont ignorées.
' - Si le tableau destination à moins de colonnes que la requête : les colonnes manquantes ne sont pas créées.
'------------------------------------------------------------------------------------------------
' Exemple pour faire la somme de la colonne "Nb" par une requête SQL où "Num" est supérieur à 5:
' Dim Enr As Variant
' Set Enr = TS_RequeteSQL(Range("TS_1"), "Sum([Nb])", "WHERE [Num] > 5")
' If Not Enr Is Nothing Then Debug.Print Enr.Fields(0).Value
' Exemple pour copier dans le tableau "TS_SQL" les données "Num" et "Nb" du tableau "TS_1" où "Num" est supérieur à 5
' et les trier par ordre décroissant des valeurs de "Nb":
' Call TS_RequeteSQL(Range("TS_1"), "[Num], [Nb]", "WHERE [Num] > 5 ORDER BY [Nb] DESC", Range("TS_SQL"), TS_RemplacerDonnées)
'------------------------------------------------------------------------------------------------
' Attention : Les nombres doivent avoir comme séparateur décimal le point, les dates doivent être au
' format anglais et entre dièses (croisillons), les chaînes entre apostrophes (simple quote).
' l'apostrophe (quote) est un mot réservé par le SQL. Si la chaîne de caractère en contient alors la doubler.
' Exemple : "WHERE [Département] = 'Val d''oise' "
' Vous pouvez utiliser la fonction TS_FormatSQL pour faire cela (surtout lorsque la donnée est une variable).
' Exemple : "WHERE [Département] = " & TS_FormatSQL("Val d'oise")
'------------------------------------------------------------------------------------------------
' Exemple pour rechercher dans "TS_Eleves" toutes les personnes (yc lignes masquées) dont le nom et prénom
' contient le texte en cellules B12 et C12 (casse non respectée) et afficher toutes les informations:
'Dim Enr As Variant, i As Integer, Nb As Long
'Set Enr = TS_RequeteSQL(Range("TS_Eleves"), "", _
'            "WHERE [Nom Famille] LIKE " & TS_FormatSQL("%" & Range("B12") & "%") _
'          & " AND [Prénom] LIKE " & TS_FormatSQL("%" & Range("C12") & "%"))
'If Not Enr Is Nothing Then
'    For Nb = 1 To Enr.RecordCount
'        For i = 0 To Enr.Fields.Count - 1: Debug.Print Enr.Fields(i).Value: Next i
'        Enr.MoveNext
'    Next Nb
'End If
' Exemple pour ajouter 2 points aux notes sans dépasser 10 (le classeur ne doit pas être en lecture seule):
'Dim Enr
'Set Enr = TS_RequeteSQL(Range("TS_Eleves"), "Note", "WHERE NOTE < 10 ")
'If Not Enr Is Nothing Then
'    While Not Enr.EOF
'        Enr.Fields(0).Value = Enr.Fields(0).Value + 2
'        If Enr.Fields(0).Value > 10 Then Enr.Fields(0).Value = 10
'        Enr.Update
'        Enr.MoveNext
'    Wend
'End If
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Pour faire une sélection dans un Tableau Structuré il faut la ligne d'en-tête,
' et supprimer les totaux pour ne pas les renvoyer:
Dim Anc_Entete As Boolean
Dim Anc_Totaux As Boolean
Dim Anc_ScreenUpdating As Boolean

Anc_Entete = TS.ListObject.ShowHeaders
Anc_Totaux = TS.ListObject.ShowTotals
Anc_ScreenUpdating = Application.ScreenUpdating

Application.ScreenUpdating = False
TS.ListObject.ShowHeaders = True
TS.ListObject.ShowTotals = False

' Requête sur le tableau de données passé en argument:
If StrChamps <> "!" Then
If TS.ListObject.ListRows.Count > 65535 Or TS.ListObject.ListColumns.Count > 255 Then
StrSQL = "SELECT " & IIf(StrChamps > "", StrChamps, "*") & " FROM [" & TS.Parent.Name & "$] " & StrSQL
Else
StrSQL = "SELECT " & IIf(StrChamps > "", StrChamps, "*") & " FROM [" & TS.Parent.Name & "$" _
& TS.ListObject.Range.Address(False, False, xlA1) & "] " & StrSQL
End If
End If

' S'il y a des enregistrements concernés alors les renvoie:
Set TS_RequeteSQL = TS_ExecuterSQL(TS, StrSQL)

' S'il faut renseigner un tableau destination:
If TS_Dest Is Nothing = False Then
TS_RequeteSQL = TS_CopierUnTableau(TS_RequeteSQL, TS_Dest, Méthode, TS_Valeurs)
If TS_RequeteSQL = -1 And Méthode = TS_RemplacerDonnées Then
Call TS_EffacerToutesLignes(TS_Dest)
Call TS_SupprimerPlusieursLignes(TS_Dest, 1, 0)
End If
End If

' Fin du traitement:
Gest_Err:

' Restaure l'affichage:
TS.ListObject.ShowHeaders = Anc_Entete
TS.ListObject.ShowTotals = Anc_Totaux
Application.ScreenUpdating = Anc_ScreenUpdating

' Gestion des erreurs:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Dest Is Nothing = False Then TS_RequeteSQL = -1 Else Set TS_RequeteSQL = Nothing
End If
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_RequeteSQL", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_RequeteSQL"
End If
Err.Clear

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

La fonction privée suivante utilise des liaisons tardives, vous n’avez donc pas besoin d’installer la bibliothèque « Microsoft ActiveX Data Objects 6.0 Library » dans votre projet.

Cliquez sur « Afficher le code » pour voir le code de la fonction privée TS_ExecuterSQL

'------------------------------------------------------------------------------------------------
Private Function TS_ExecuterSQL(TS As Range, ByVal StrSQL As String) As Variant  ' => ADODB.Recordset
'------------------------------------------------------------------------------------------------
' Exécute une requête au format SQL.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' StrSQL : La requête.
'------------------------------------------------------------------------------------------------
' La liaison anticipée nécessite d'installer la référence : Microsoft ActiveX Data Objects 6.0 Library
' La liaison tardive permet de ne pas référencer la bibliothèque ADO.
' L’instanciation d’objets à l’aide de la liaison tardive est généralement plus lente
' que l’utilisation de la Liaison anticipée.
' Ici la liaison tardive a été adoptée uniquement pour vous éviter d'installer manuellement une
' référence et donc simplifier la portabilité du code.
' Les remarques ci-dessous indiquent comment adapter le code pour une liaison anticipée.
'------------------------------------------------------------------------------------------------
' Provider et Extended à utiliser:
' Soit Microsoft.Jet.OLEDB.4.0 et Excel 8.0
' Soit Microsoft.ACE.OLEDB.12.0 et Excel 12.0 (voire Excel 14.0)
' Remarque sur "IMEX=1". Voir ici (si IMEX=1 alors UPDATE n'est pas disponible):
' https://social.msdn.microsoft.com/Forums/sqlserver/en-US/5312f489-391f-4536-8a6a-121b18ea9c94/
' what-is-the-benfits-of-imex-in-connection-to-excel-file-2007-?forum=csharpgeneral
' https://stackoverflow.com/questions/46170343/reading-excel-sheet-using-ace-oledb-12-0-with-imex-1-not-working
' https://stackoverflow.com/questions/11341535/what-is-the-default-value-of-imex-in-oledb
'------------------------------------------------------------------------------------------------
Dim Cnn As Variant  ' Liaison anticipée => As ADODB.Connection
Dim Rs As Variant   ' Liaison anticipée => As ADODB.Recordset

' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
Set TS_ExecuterSQL = Nothing

' Création d'une connexion:
Set Cnn = CreateObject("ADODB.Connection") ' Liaison anticipée => Set Cnn = New ADODB.Connection
Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & TS.Worksheet.Parent.FullName & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes"";" ' Pour permettre les mises à jour : UPDATE.

' Exécute une requête SQL sur un jeu d'enregistrements:
StrSQL = Replace(StrSQL, "[[", "[")
StrSQL = Replace(StrSQL, "]]", "]")
Set Rs = CreateObject("ADODB.Recordset") ' Liaison anticipée => Set Rs = New ADODB.Recordset
Rs.Open StrSQL, Cnn, 1, 2, 1 ' Liaison anticipée => 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 (facultatif).
Set TS_ExecuterSQL = Rs  ' Renvoie les enregistrements.
End If

' Fin du traitement, libération des mémoires:
Gest_Err:
Set Rs = Nothing
Set Cnn = Nothing
If Err.Number = -2147217904 Then Err.Clear ' pas de donnée.
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then Set TS_ExecuterSQL = Nothing
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ExecuterSQL", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ExecuterSQL"
End If
Err.Clear

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

XII-C - TS_ModifierSQL

La fonction TS_ModifierSQL exécute une requête SQL sur un tableau structuré pour modifier les données d'une colonne (même si elles sont masquées.

Attention : pour exécuter une mise à jour des données la fonction TS_ModifierSQL le classeur ne doit pas être en lecture seule.

Ses arguments sont :

- TS : la plage (de type Range) qui représente le tableau structuré (s'il fait plus de 65 535 lignes ou 255 colonnes alors le tableau devra être unique sur la feuille sans quoi il y a un risque que la requête ne sélectionne pas les bonnes données) ;

- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée ;

- StrSQL : la requête SQL des critères de sélection des enregistrements concernés ;

- Valeur : la valeur de référence ;

- Méthode : (facultatif) indique le mode de mise à jour des données, suivant l'énumération personnelle Enum_ModifierSQL :
- TS_Update_Valeur : (par défaut) modifie la valeur qui prend la valeur passée dans Valeur,
- TS_Update_Ajouter : ajoute à la valeur existante la valeur passée dans Valeur,
- TS_Update_Soustraire : soustrait à la valeur existante la valeur passée dans Valeur,
- TS_Update_Multiplier : multiplie la valeur existante par la valeur passée dans Valeur,
- TS_Update_Diviser : divise la valeur existante par la valeur passée dans Valeur.

La fonction renvoie : True si tout s’est bien passé ou False dans le cas contraire.

Exemple pour ajouter 2 points à toutes les notes (pas de critère de sélection dans la requête SQL) puis limiter les notes à 20 (cette fois il faut sélectionner les notes supérieures à 20 dans la requête SQL) :

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Call TS_ModifierSQL(Range("TS_Eleves"), "Note", "", 2, TS_Update_Ajouter)
Call TS_ModifierSQL(Range("TS_Eleves"), "Note", "WHERE [Note] > 20", 20, TS_Update_Valeur)
End Sub
'------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------
Public Function TS_ModifierSQL(TS As Range, Colonne As Variant, _
ByVal StrSQL As String, _
ByVal Valeur As Variant, _
Optional Méthode As Enum_ModifierSQL = TS_Update_valeur) As Boolean
'------------------------------------------------------------------------------------------------
' Modifie les données d'une colonne d'un tableau structuré (même sur les lignes masquées).
' Les données sont sélectionnées par une requête SQL.
' ATTENTION : le classeur ne doit pas être en lecture seule.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré (si > 65535 lignes ou > 255 colonnes alors les champs doivent être
' uniques sur la feuille sinon il y a un risque de se tromper de tableau).
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors renvoie le numéro de la dernière colonne du tableau.
' StrSQL : La requête SQL avec ses conditions d'identification des enregistrements concernés.
' Valeur : La valeur de référence.
' Méthode : (facultatif) énumération Enum_ModifierSQL  =
'    TS_Update_Valeur : (par défaut) Modifie la valeur qui prend la valeur passée dans Valeur.
'    TS_Update_Ajouter : Ajoute à la valeur existante la valeur passée dans Valeur.
'    TS_Update_Soustraire : Soustrait à la valeur existante la valeur passée dans Valeur.
'    TS_Update_Multiplier : Multiplie la valeur existante par la valeur passée dans Valeur.
'    TS_Update_Diviser : Divise la valeur existante par la valeur passée dans Valeur.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Exemple pour ajouter 2 points aux notes puis limiter les notes à 20 :
'Call TS_ModifierSQL(Range("TS_Eleves"), "Note", "", 2, TS_Update_Ajouter)
'Call TS_ModifierSQL(Range("TS_Eleves"), "Note", "WHERE [Note] > 20", 20, TS_Update_Valeur)
'------------------------------------------------------------------------------------------------
' Attention : Les nombres doivent avoir comme séparateur décimal le point, les dates doivent être au
' format anglais et entre dièses (croisillons), les chaîne entre apostrophes (simple quote).
' l'apostrophe est un mot réservé par le SQL. Si la chaîne de caractère en contient la doubler.
' Exemple : "WHERE [Département] = 'Val d''oise' "
' Vous pouvez utiliser la fonction TS_FormatSQL pour faire cela (surtout lorsque la donnée est une variable).
' Exemple : "WHERE [Département] = " & TS_FormatSQL("Val d'oise")
'------------------------------------------------------------------------------------------------
Dim Enr As Variant
Dim i As Long
Dim StrChamp As String

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

' Pour faire une sélection dans un Tableau Structuré il faut la ligne d'en-tête,
' et supprimer les totaux pour ne pas les renvoyer:
Dim Anc_Entete As Boolean
Dim Anc_Totaux As Boolean
Dim Anc_ScreenUpdating As Boolean

Anc_Entete = TS.ListObject.ShowHeaders
Anc_Totaux = TS.ListObject.ShowTotals
Anc_ScreenUpdating = Application.ScreenUpdating

Application.ScreenUpdating = False
TS.ListObject.ShowHeaders = True
TS.ListObject.ShowTotals = False

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
' Retrouve son nom pour l'utiliser dans la requête SQL:
StrChamp = TS.ListObject.ListColumns(Colonne).Name

' Requête sur le tableau passé en argument:
If TS.ListObject.ListRows.Count > 65535 Or TS.ListObject.ListColumns.Count > 255 Then
StrSQL = "SELECT [" & StrChamp & "] FROM [" & TS.Parent.Name & "$] " & StrSQL
Else
StrSQL = "SELECT [" & StrChamp & "] FROM [" & TS.Parent.Name & "$" _
& Left(TS.ListObject.HeaderRowRange.Address(False, False, xlA1), InStr(1, TS.ListObject.HeaderRowRange.Address(False, False, xlA1), ":") - 1) _
& Mid(TS.ListObject.DataBodyRange.Address(False, False, xlA1), InStr(1, TS.ListObject.DataBodyRange.Address(False, False, xlA1), ":")) _
& "] " & StrSQL
End If

' S'il y a des enregistrements concernés alors les traiter:
Set Enr = TS_ExecuterSQL(TS, StrSQL)
If Not Enr Is Nothing Then
For i = 1 To Enr.RecordCount
Select Case Méthode
Case TS_Update_Valeur: Enr.Fields(0).Value = Valeur
Case TS_Update_Ajouter: Enr.Fields(0).Value = Enr.Fields(0).Value + Valeur
Case TS_Update_Soustraire: Enr.Fields(0).Value = Enr.Fields(0).Value - Valeur
Case TS_Update_Multiplier: Enr.Fields(0).Value = Enr.Fields(0).Value * Valeur
Case TS_Update_Diviser: Enr.Fields(0).Value = Enr.Fields(0).Value / Valeur
End Select
' Enregistre la mise à jour et passe à l'enregistrement suivant:
Enr.Update
Enr.MoveNext
Next i
End If

' Renvoie VRAI:
TS_ModifierSQL = True

' Fin du traitement:
Gest_Err:

' Restaure l'affichage:
TS.ListObject.ShowHeaders = Anc_Entete
TS.ListObject.ShowTotals = Anc_Totaux
Application.ScreenUpdating = Anc_ScreenUpdating

' Gestion des erreurs:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ModifierSQL", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ModifierSQL"
End If
Err.Clear

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

XII-D - TS_FormatSQL

La fonction TS_FormatSQL permet de mettre au format SQL une valeur passée dans un requête.
Par exemple une chaîne de caractère comportant une apostrophe (ou simple quote), caractère réservé au SQL, génèrera une erreur de conversion. Dans ce cas il faut la doubler pour que le SQL l'interprète correctement. De même les dates doivent être passées au format "année/mois/jour" et les nombres doivent avoir comme séparateur décimal un point et non pas une virgule.
Cette fonction vous simplifiera la vie en faisant ces corrections et en renvoyant une valeur admise par le SQL.

Ses arguments sont :

- Valeur : la valeur à traiter ;

- FormatSQL : (facultatif) Le format désiré, suivant l'énumération personnelle Enum_FormatSQL :
- TS_Standard : (par défaut) identifie le format de l'argument Valeur et applique le même,
- TS_Chaine : force le format chaîne de caractères,
- TS_Date : force le format date (une chaîne au format "AAAAMMJJ" est convertie en date),
- TS_Numérique : force le format numérique.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function TS_FormatSQL(Valeur As Variant, _
Optional ByVal FormatSQL As Enum_FormatSQL = TS_Standard) As String
'------------------------------------------------------------------------------------------------
' Renvoie la valeur passée en argument au format pour une requête SQL, c'est-à-dire, met les
' doubles apostrophes dans les chaînes, les points pour les numériques et le format anglais pour les
' dates.
'------------------------------------------------------------------------------------------------
' Valeur : La valeur à traiter.
' FormatSQL : (facultatif) Le format désiré, suivant l'énumération personnelle Enum_FormatSQL :
'    TS_Standard = (par défaut) identifie le format de l'argument Valeur et applique le même.
'    TS_Chaine = force le format chaîne de caractères.
'    TS_Date = force le format date. (une chaîne au format AAAAMMJJ est convertie en date).
'    TS_Numérique = force le format numérique.
'------------------------------------------------------------------------------------------------
' Renvoie : la valeur convertie, entre apostrophes pour une chaîne ou entre dièses (croisillons) pour une date.
'------------------------------------------------------------------------------------------------
' Remarques:
' TS_FormatSQL("12 345 678 999,11", TS_Standard) renvoie 12345678999.11
' TS_FormatSQL("12 345 678 999.11", TS_Standard) renvoie '12 345 678 999.11'
' TS_FormatSQL("12 345 678 999.11", TS_Numérique) renvoie 12345678999.11
' Le format "12.345.678.999,11" n'est pas pris en compte, il faut supprimer les points:
' TS_FormatSQL(Replace("12.345.678.999,11", ".", ""))
'----------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' S'il faut déterminer le format de l'argument Valeur:
If FormatSQL = TS_Standard Then
FormatSQL = TS_Chaine
If IsDate(Valeur) = True Then FormatSQL = TS_Date
If IsNumeric(Valeur) = True Then FormatSQL = TS_Numérique
End If

' Suivant le format à appliquer:
Select Case FormatSQL

Case TS_Chaine
TS_FormatSQL = "'" & Replace(Valeur, "'", "''") & "'"

Case TS_Date
If IsDate(Valeur) = True Then TS_FormatSQL = "#" & Format(Valeur, "yyyy/mm/dd") & "#"
If Valeur Like "########" Then _
TS_FormatSQL = "#" & Left(Valeur, 4) & "/" & Mid(Valeur, 5, 2) & "/" & Right(Valeur, 2) & "#"

Case TS_Numérique
TS_FormatSQL = Format(Valeur)
TS_FormatSQL = Replace(TS_FormatSQL, " ", "")
TS_FormatSQL = Replace(TS_FormatSQL, ",", ".")

End Select

' Fin du traitement:
Gest_Err:

' Fin du traitement:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_FormatSQL", TS_Err_Description
If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_FormatSQL"
End If
Err.Clear

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

XIII - Annexe 2 – Fusionner deux fichiers PDF en VBA

Si vous disposez de l’application « Adobe Acrobat Pro » vous pouvez fusionner deux fichiers PDF en utilisant le code VBA suivant :

'------------------------------------------------------------------------------------------------
Public Function FusionAcrobatPro(FichierSource As String, _
FichierAJoindre As String, _
FichierDestination As String, _
Ouvrir As Boolean) As Boolean
'------------------------------------------------------------------------------------------------------
' Fait la fusion de deux fichiers PDF pour en générer un troisième.
' Documentation Officielle:
' https://opensource.adobe.com/dc-acrobat-sdk-docs/acrobatsdk/html2015/index.html#t=Acro12_MasterBook%2FIAC_API_OLE_Objects%2FAcroExch_PDDoc.htm
'------------------------------------------------------------------------------------------------------
' FichierSource : le fichier d'origine (qui contient les premières pages).
' FichierAJoindre : le fichier à joindre au fichier d'origine, a la suite du fichier d'origine.
' FichierDestination : le fichier qui sera générer par cette fusion.
' Ouvrir : VRAI s'il faut ouvrir le fichier fusionné.
'------------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Exemple:
' Call FusionAcrobatPro("C:\Users\ott_l\Downloads\FichierA.pdf", _
'                       "C:\Users\ott_l\Downloads\FichierB.pdf"_
'                       "C:\Users\ott_l\Downloads\Fusion.pdf", True)
'------------------------------------------------------------------------------------------------------
' Cas de la liaison tardive:
Const PDSaveFull = 1

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

Dim oPdfDoc1 As Object
Dim oPdfDoc2 As Object

Set oPdfDoc1 = CreateObject("AcroExch.PDDoc")
Set oPdfDoc2 = CreateObject("AcroExch.PDDoc")

If oPdfDoc1.Open(FichierSource) = False Then _
Err.Raise vbObjectError, "FusionAcrobatPro", "Le fichier [" & FichierSource & "] n'a pas été trouvée."

If oPdfDoc1.GetNumPages() < 1 Then _
Err.Raise vbObjectError, "FusionAcrobatPro", "Impossible de lire les pages du fichier [" & FichierSource & "]."

If oPdfDoc2.Open(FichierAJoindre) = False Then _
Err.Raise vbObjectError, "FusionAcrobatPro", "Le fichier [" & FichierAJoindre & "] n'a pas été trouvée."

If oPdfDoc2.GetNumPages() < 1 Then _
Err.Raise vbObjectError, "FusionAcrobatPro", "Impossible de lire les pages du fichier [" & FichierAJoindre & "]."

If oPdfDoc1.InsertPages(0, oPdfDoc2, 0, oPdfDoc2.GetNumPages(), 0) = False Then _
Err.Raise vbObjectError, "FusionAcrobatPro", "Impossible de fusionné les fichiers [" & FichierSource & "] + [" & FichierAJoindre & "]."

If oPdfDoc1.Save(PDSaveFull, FichierDestination) = False Then _
Err.Raise vbObjectError, "FusionAcrobatPro", "Impossible de sauvegarder la fusion [" & FichierDestination & "]."

If Ouvrir = True Then Call Shell("Explorer.exe " & FichierDestination, vbMaximizedFocus)

' Fin du traitement:
Gest_Err:
If Err.Number <> 0 Then
MsgBox "Erreur : " & Err.Number & vbCrLf & vbCrLf _
& "Description : " & Err.Description & vbCrLf & vbCrLf _
& "Source : " & Err.Source & vbCrLf & vbCrLf _
, vbCritical, "L'application rencontre une erreur de traitement"
Else
FusionAcrobatPro = True
End If

On Error Resume Next
oPdfDoc1.Close
oPdfDoc2.Close

Set oPdfDoc1 = Nothing
Set oPdfDoc2 = Nothing

Err.Clear
End Function
'------------------------------------------------------------------------------------------------

XIV - Annexe 3 – Contrôler la validation des données

Comme indiqué en introduction de cette documentation, utiliser les tableaux structurés apporte de nombreux avantages pour l’utilisateur mais surtout pour le programmeur, d’autant plus qu’il trouvera ici un large éventail de fonctions pour lui simplifier la vie.

Mais encore faut-il, pour un travail correct, que les données soient fiables. C’est-à-dire qu’elles respectent le format attendu.
Par exemple un texte dans une cellule qui attend une date va certainement générer des erreurs lors des traitements.

Pour contrôler la cohérence des saisies faites par l’utilisateur, Excel met à notre disposition dans le menu « Données / Validation des données » un outil permettant de restreindre une saisie à certaines conditions.
Ça s’applique très bien pour une date, pour une liste de choix, pour un entier ou un décimal, pour un texte dont on veut limiter la longueur…

Mais il n’est pas facile de restreindre la saisie à un format spécifique. Par exemple une référence de produit devant contenir deux lettres majuscules suivies d’un trait et de deux chiffres.
De même certains utilisateurs vont saisir un accent dans un nom de famille, d’autres pas, d’où un problème lorsqu’il faudra analyser les données.

La solution de contournement est de programmer une procédure événementielle à chaque changement de valeur saisie
Private Sub Worksheet_Change(ByVal Target As Range) et de vérifier le contenu de la saisie pour la corriger si besoin.
Soit du sur-mesure. Ce qui demande du temps de programmation et ne simplifie pas la maintenance de l’application.

La méthode employée dans cette discussion apporte, à mon avis, une bonne réponse pour restreindre la saisie à un modèle.
Elle utilise la « Validation des données » mais en la complétant par la technologie des « expressions régulières ».
Voir ici pour plus d’informations si vous ne savez pas comment utiliser les modèles de formats des expressions régulières.

La principe m’a inspiré pour aller encore plus loin, c’est-à-dire pour forcer le format de restitution de la saisie.
Par exemple pour mettre un nom en majuscules même si l’utilisateur l’a saisi en minuscules.
Du coup il n’est plus nécessaire de repasser après chaque saisie pour la corriger puisque tout est pris en compte directement lors de la saisie, ce qui simplifie leur gestion.

Nous utiliserons l’onglet « Message de saisie » pour renseigner dans le titre le format de restitution souhaité et dans le corps du message le modèle attendu de la saisie.

J’ai prévu quatre formats de restitution pour les chaînes de caractères, à renseigner dans le titre (évidement si rien n’est renseigné aucune transformation de la saisie ne sera réalisée) et la possibilité d'accepter une cellule vide :

- > : met tout en majuscules ;

- >> : met chaque première lettre d'une chaîne en majuscule et le reste en minuscule (Proper) ;

- < : met tout en minuscules ;

- >< : met la première lettre d'une chaîne en majuscule et le reste en minuscule ;

- ! : une cellule vide est acceptée.

Le modèle de l’expression régulière sera renseigné dans le corps du message, mais j’ai un peu triché en ajoutant des modèles personnalisés :

- Mail : pour la saisie d'une adresse électronique, soit le modèle de l’expression régulière « ^[\w\.\-]+@[A-Za-z0-9]+[A-Za-z0-9\.\-]*[A-Za-z0-9]+\.[A-Za-z]{2,24}$ » ;

- Password : pour la saisie d'un mot de passe de 8 caractères minimum dont une lettre, un chiffre, un caractère spécial ;

- « Name= » suivi du nom de la cellule : pour faire référence à une cellule nommée et reprendre le modèle contenu dans cette cellule ;

- « Like= » suivi de la règle : pour utiliser l'opérateur LIKE beaucoup moins puissant que les expressions régulières mais plus facile à comprendre et peut être utilisé sur des règles simples de longueur fixe. Exemple : « Like=[A-Z][A-Z]-[0-9][0-9] » ;

- pour rendre la saisie unique et donc interdire la saisie de doublons (pour une chaîne), ajoutez à la suite du modèle :
- Unique=Tableau[Colonne] : où "Tableau" est le nom d'un tableau structuré et "Colonne" le nom de la colonne de référence. Exemple : « Unique=TS_Eleves[Nom] »,
- Unique=Feuille!Plage : où "Feuille" est le nom d'une feuille de calcul et "Plage" la plage de référence. Exemple : « Unique=Feuil_Source!D:D »,
- Unique=Plage : où "Plage" est la plage de référence sur la feuille active. Exemple : "Unique=B3:B9",
- Unique=? : pour faire référence à la colonne de la cellule dans le tableau structuré ;

- pour traiter le résultat d'une formule ajoutez à la suite du modèle « Formule= » suivi de l'adresse de la cellule contenant la formule. La formule doit renvoyer Vrai ou Faux afin de déterminer si la saisie est, respectivement, correcte ou non.
- Formule=Tableau[@Colonne] : où "Tableau" est le nom du tableau structuré de la cellule et "Colonne" le nom de la colonne où se trouve la formule. Le signe « @ » signifie qu'il faut prendre la ligne de la cellule active. Exemple : « Formule=TS_Eleves[@[Sans Doublon]] » avec comme formule dans la colonne "Sans Doublon" pour compter le nombre de fois que le couple "Nom Famille" et "Prénom" est présent dans le tableau afin d'interdire les doublons sur ce couple de données :
« =NB.SI.ENS([Nom Famille];[@[Nom Famille]];[Prénom];[@Prénom])<=1 ».
La formule « Formule=TS_Eleves[@[Sans Doublon]] » sera à placer dans les conditions de validation des cellules des colonnes "Nom Famille" et "Prénom",
- Formule=Feuille!Plage : où "Feuille" est le nom d'une feuille de calcul et "Plage" la plage de référence. Exemple : « Formule=Feuil_Source!A1 » si la formule est sur une autre feuille ou tout simplement « Formule=A1 » si elle est sur la feuille active ;

- - « Formule= » suivi d'une formule mise au format anglais et qui renvoie Vrai ou Faux peut aussi être utilisé, si vous maitrisez bien les formules en anglais. Attention les points-virgules de nos formules sont à remplacer par des virgules.
Pour reprendre l'exemple d'une validation sans doublon sur le couple "Nom Famille" et "Prénom" en utilisant directement une formule et non plus l'adresse d'une cellule qui contient la formule, cela donne :
« Formule=COUNTIFS(TS_Eleves[Nom Famille],TS_Eleves[@[Nom Famille]],TS_Eleves[Prénom],TS_Eleves[@Prénom])<=1 ».
Formule à placer dans les cellules des colonnes "Nom Famille" et "Prénom".

Vous pouvez compléter par d'autres modèles...

Avant cela il faut inclure dans votre projet le module « Validation_Données » (que vous trouverez dans le fichier joint à cette documentation) qui contient les fonctions EstValide et RegExpMatch que nous détaillerons plus loin.

Puis dans le gestionnaire de noms, créer un nom nommé arbitrairement : « Controle_Validation ».
Qui fait référence à : « =EstValide() ».
Vous pouvez maintenant paramétrer les conditions de validation désirées via l’outil « Validation des données ».

Par exemple pour une saisie d’un nom de famille de 25 caractères au plus, sans accent ni caractères spéciaux et devant être mis en majuscules, placez-vous dans la cellule concernée puis configurez ainsi :
- Onglet « Options »
o Autoriser : « Personnalisé »
o Case « Ignorer si vide » : non cochée
o Formule : « =Controle_Validation »

- Onglet « Message de saisie »
o Titre : « > »
o Message de saisie : « ^[A-Za-z ]{1,25}$ »

- Onglet « Alerte d’erreur » : libre à vous de mettre ce que vous souhaitez.

Puis décochez la case « Quand la cellule est sélectionnée ».

La fonction EstValide est appelée chaque fois qu’une saisie est réalisée. Elle va prendre comme références les informations enregistrées dans le « message du titre » pour le modèle de saisie admis et le « titre » comme modèle de format à appliquer.

Cliquez sur « Afficher le code » pour voir le code de la fonction EstValide

'------------------------------------------------------------------------------------------------
' https://www.ablebits.com/office-addins-blog/excel-data-validation-regex/
' https://www.ablebits.com/office-addins-blog/regex-match-excel/#regexpmatch-function
' https://learn.microsoft.com/fr-fr/dotnet/standard/base-types/regular-expression-langage-quick-reference
' https://www.developpez.net/forums/d2150525/logiciels/microsoft-office/excel/macros-vba-excel/selection-caractere-cellule/
' https://support.microsoft.com/fr-fr/office/application-d-une-validation-des-donn%C3%A9es-aux-cellules-29fecbcc-d1b9-42c1-9d76-eff3ce5f7249

Option Explicit

'---------------------------------------------------------------------------------------
Public Function EstValide() As Variant
'---------------------------------------------------------------------------------------
' Vérifie la validation d'une saisie dans une cellule en utilisant la technique
' des expressions régulières. Pour cela on va utiliser la "Validation des données" classique
' mais en utilisant une formule qui fait référence à un nom qui fait lui-même référence à une
' fonction. Le Modèle de l'expression régulière sera enregistré dans le message de saisie.
' En plus il est possible d'indiquer un format à appliquer à la saisie. Dans ce cas il
' faut l'enregistrer dans le titre du message de saisie (sans les guillemets).
'---------------------------------------------------------------------------------------
' Exemple:
' Dans le gestionnaire des noms créez "Controle_Validation" qui fait référence à "=EstValide()"
' Et dans la validation (Données/validation des données):
' - la case "Ignorer si vide" doit être décochée;
' - la formule personnalisée doit contenir "=Controle_Validation";
' - le titre peut contenir le format de restitution (pour les chaînes);
' - le message de saisie doit contenir le modèle (de l'expression régulière ou personnalisé);
' - puis décochez "Quand la cellule est sélectionnée".
'---------------------------------------------------------------------------------------
' Remarques:
' J'ai prévu des modèles personnalisés:
' - pour la saisie d'un mail enregistrez "Mail".
' - pour la saisie d'un mot de passe enregistrez "Password". (règle = 8 caractères minimum dont une
' lettre, un chiffre, un caractère spécial.
' - pour faire référence à une cellule nommée qui contient le modèle de l'expression régulière
' enregistrez "Name=" suivi du nom de la cellule.
' - pour utiliser l'opérateur LIKE: enregistrez "Like=" suivi de la règle.
' LIKE est beaucoup moins puissant que les expressions régulières mais plus simple à comprendre
' et peut être utilisé sur des règles simples de longueur fixe.
' - pour rendre la saisie unique (pour une chaîne), ajoutez à la suite du modèle :
' o "Unique=Tableau[Colonne]" où Tableau est le nom d'un tableau structuré et Colonne le nom de la colonne ;
' o "Unique=Feuille!Plage" où feuille est le nom de la feuille et Plage la plage. Ex: "Unique=Feuil_Source!D:D" ;
' o "Unique=Plage" où Plage est la plage sur la feuille de la cellule analysée. Ex: "Unique=B3:B9" ;
' o "Unique=?" dans le tableau structuré de la cellule analysée pour faire référence à sa colonne.
' - pour traiter le résultat d'une formule ajoutez à la suite du modèle "Formule=" suivi soit :
' o de l'adresse de la cellule contenant la formule qui doit renvoyer Vrai ou Faux.
' Ex: "Formule=Tableau1[@[Sans Doublon]]" si la formule est dans un tableau structuré,
' Ex: "Formule=Feuil_Source!A1" si la formule est dans une cellule d'une autre feuille;
' o de la formule mise entre au format anglais qui doit renvoyer Vrai ou Faux:
' Ex: "Formule=COUNTIFS(TS_Eleves[Nom Famille],TS_Eleves[@[Nom Famille]],TS_Eleves[Prénom],TS_Eleves[@Prénom])<2"
'
' Vous pouvez compléter par d'autres modèles...
' Cinq formats sont disponibles (vous pouvez en inventer d'autres):
' ">"  : met tout en majuscule
' ">>" : met chaque première lettre en majuscule (Proper) et le reste en minuscule.
' "><" : met la première lettre en majuscule le reste en minuscule.
' "<"  : met tout en minuscule.
' "!" : une cellule vide est acceptée.
'---------------------------------------------------------------------------------------
Dim Modele As String
Dim MonFormat As String
Dim Unique As String, Formule As String, Eval As Variant
Dim i As Integer

' Par défaut la fonction renvoie FAUX:
EstValide = False

' Récupère le modèle de l'expression régulière enregistré dans le message de saisie
' de "Données/validation des données/message de saisie" de la cellule:
Modele = ActiveCell.Validation.InputMessage
Modele = Replace(Modele, Chr(10), "")
Modele = Replace(Modele, Chr(13), "")
' Récupère le format à appliquer à la saisie enregistré dans le titre
' de "Données/validation des données/message de saisie" de la cellule:
MonFormat = ActiveCell.Validation.InputTitle
If InStr(1, MonFormat, "!") > 0 Then
If ActiveCell.Value = "" Then EstValide = True: Exit Function
End If
MonFormat = Replace(MonFormat, "!", "")

' S'il faut faire référence à une cellule:
If Left(UCase(Modele), 5) = "NAME=" Then
Modele = Replace(Modele, "Name=", "", , , vbTextCompare)
Modele = Range(Modele).Value
End If

' S'il faut que la saisie soit unique:
i = InStr(1, Modele, "Unique=", vbTextCompare)
If i > 0 Then
Unique = Mid(Modele, i + 7)
Modele = Left(Modele, i - 1)
If Unique = "?" Then
i = ActiveCell.Column - Range(ActiveCell.ListObject.Name).Column + 1
Unique = ActiveCell.ListObject.Name & "[" & Range(ActiveCell.ListObject.Name).ListObject.ListColumns(i).Name & "]"
End If
End If

' S'il faut faire référence à une cellule qui contient une formule qui renvoie Vrai ou Faux:
i = InStr(1, Modele, "Formule=", vbTextCompare)
If i > 0 Then
Formule = Mid(Modele, i + 8)
Modele = Left(Modele, i - 1)
End If

' Suivant le modèle indiqué:
Select Case True
Case Modele = "": EstValide = True
Case UCase(Modele) = "MAIL": EstValide = RegExpMatch(ActiveCell, "^[\w\.\-]+@[A-Za-z0-9]+[A-Za-z0-9\.\-]*[A-Za-z0-9]+\.[A-Za-z]{2,24}$")
Case UCase(Modele) = "PASSWORD": EstValide = RegExpMatch(ActiveCell, "^(?=.*[A-Za-z])(?=.*\d)(?=.*[@$!%*#?&_-])[A-Za-z\d@$!%*#?&_-]{8,}$")
Case Left(UCase(Modele), 5) = "LIKE=": EstValide = ActiveCell.Value Like Mid(Modele, 6)
Case Else: EstValide = RegExpMatch(ActiveCell, Modele)
End Select

DoEvents
Dim M
M = ActiveCell.Value
ActiveCell.Value = EstValide
If ActiveCell.Value = True Then
' Gestion des formats:
Select Case MonFormat
Case ">>": M = Application.Proper(M)
Case ">":  M = UCase(M)
Case "<":  M = LCase(M)
Case "><": M = LCase(M): Mid(M, 1, 1) = UCase(Mid(M, 1, 1))
End Select
ActiveCell.Value = M
' Gestion d'une valeur unique:
If Unique <> "" Then
EstValide = Application.Evaluate("=COUNTIF(" & Unique & ",""" & ActiveCell.Value & """)") <= 1
End If
' Gestion d'une formule:
If Formule <> "" Then
Eval = Application.Evaluate(Formule)
If Eval <> True Then Formule = "=" & Formule: Eval = Application.Evaluate(Formule)
EstValide = Eval
End If
End If
ActiveCell.Value = M

End Function

'---------------------------------------------------------------------------------------
Private Function RegExpMatch(Input_Range As Range, Pattern As String, Optional Match_Case As Boolean = True) As Variant
'---------------------------------------------------------------------------------------
Dim RegEx

On Error GoTo ErrHandl
RegExpMatch = False

Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Pattern = Pattern
RegEx.Global = True
RegEx.MultiLine = True
RegEx.Ignorecase = Not Match_Case

RegExpMatch = RegEx.test(Input_Range.Value)

Exit Function
ErrHandl:
RegExpMatch = CVErr(xlErrValue)
End Function
'------------------------------------------------------------------------------------------------

Si cette méthode de validation des données assure l’intégrité des saisies réalisées, un copier/coller échappe à ce contrôle et permet malheureusement de placer des données au mauvais format. Pour s’en prémunir nous allons empêcher le copier/coller sur les cellules sensibles avec l'instruction Application.CutCopyMode = False activée à chaque sélection d'une cellule.

Le code de l'événement à placer sur la feuille contenant des cellules avec validation de données :

'------------------------------------------------------------------------------------------------
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'------------------------------------------------------------------------------------------------
' Empêche de coller sur une cellule avec une validation de données (ou si plusieurs cellules sélectionnées):
On Error Resume Next
Dim F As String
F = Target.Validation.Formula1
If F <> "" Or Target.Count > 1 Then Application.CutCopyMode = False
On Error GoTo 0
End Sub
'------------------------------------------------------------------------------------------------

Mais ce n'est pas suffisant. Car si l'utilisateur sélectionne la cellule puis bascule dans une autre application pour copier des données et les colle dans la cellule active, l'événement sur changement de sélection n'est pas exécuté et le copier/coller n'est pas annulé.
Idem si l'utilisateur modifie ou supprime la règle de validation d'une cellule.
Avant de sauvegarder le classeur nous allons donc contrôler la conformité des règles de validation des données de nos tableaux structurés.
En cas d'erreur la cellule concernée est sélectionnée et l'enregistrement est annulé.

Le code de l'événement à placer sur l'objet ThisWorkbook, ici le tableau structuré "TS_Eleves" est contrôlé mais vous adapterez le code à votre situation.
Vous pouvez définir le niveau d'alerte :

- xlValidAlertStop : bloque les validations non conformes avec l'icône d'arrêt mais ne bloque pas les avertissements et les informations ;

- xlValidAlertWarning : bloque les validations non conformes avec l'icône d'arrêt ou avertissements mais ne bloque pas les informations ;

- xlValidAlertInformation : bloque toutes les validations non conformes.

'------------------------------------------------------------------------------------------------
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'------------------------------------------------------------------------------------------------
' Refuse la sauvegarde du classeur s'il y a des alertes stop non valides (laisse passer les alertes
' avertissement et informations):
If TS_EstValide(Range("TS_Eleves"), xlValidAlertStop) = False Then Cancel = True
End Sub
'------------------------------------------------------------------------------------------------

Le code de la fonction TS_EstValide, que vous trouverez dans le module Validation_Données du fichier joint :

Cliquez sur « Afficher le code » pour voir le code de la fonction TS_EstValide

'------------------------------------------------------------------------------------------------
Public Function TS_EstValide(TS As Range, Optional StyleAlerte As XlDVAlertStyle = xlValidAlertStop) As Boolean
'------------------------------------------------------------------------------------------------
' Contrôle que toutes les règles de validation des données soient justes sur une feuille.
' TS : Le Tableau Structuré à contrôler ou une plage classique comme "Sheets("Feuil1").Range("A1")",
' le contrôle porte sur toutes les données de la feuille et pas uniquement la plage indiquée.
' StyleAlerte = le style d'alerte minimum pour bloquer la validation:
' xlValidAlertStop          1     Icône d'arrêt.
' xlValidAlertWarning       2     Icône d'avertissement.
' xlValidAlertInformation   3     Icône d'information.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout est conforme, Faux dans le cas contraire et sélectionne la cellule
' concernée.
'------------------------------------------------------------------------------------------------
Dim C As Range, F, FF, Feuille As String
Dim Val As Range, x As Integer, y As Long
On Error Resume Next

' Par défaut renvoie Vrai:
TS_EstValide = True

' Désactive l'écran et les événements:
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Cursor = xlWait

' Mémorise la feuille actuelle et active celle des contrôles:
Feuille = ActiveSheet.Name
Sheets(TS.Parent.Name).Visible = True
Sheets(TS.Parent.Name).Activate

' Sélectionne les cellules avec des validations dans toute la feuille:
Set Val = ActiveCell.SpecialCells(xlCellTypeAllValidation)
' Si TS est un tableau alors ne sélectionne que les cellules avec des validations
' uniquement pour le tableau:
Set Val = TS.ListObject.DataBodyRange.SpecialCells(xlCellTypeAllValidation)

' Boucle sur les cellules pour analyser les validations:
If Not Val Is Nothing Then
For Each C In Val
F = ""
F = C.Validation.Formula1
Select Case F
' Si aucune validation n'est affectée:
Case ""
' Cas d'une validation personnelle avec "=Controle_Validation":
Case "=Controle_Validation"
If C.Validation.AlertStyle <= StyleAlerte Then
C.Select
If EstValide = False Then
TS_EstValide = False: Exit For
End If
End If
' Autres cas de validation (validation classique Excel):
Case Else
If C.Validation.AlertStyle <= StyleAlerte Then
C.Select
If ActiveCell.Validation.Value = False Then
TS_EstValide = False: Exit For
End If
End If
End Select
Next C
End If

' Si c'est un tableau structuré alors vérifie pour chaque colonne que les
' règles de validations sont identiques pour chaque cellule:
FF = ""
If TS_EstValide = True Then
For x = 1 To TS_Nombre_Colonnes(TS)
FF = ""
FF = TS.ListObject.DataBodyRange(1, x).Validation.Formula1 _
& TS.ListObject.DataBodyRange(1, x).Validation.InputMessage _
& TS.ListObject.DataBodyRange(1, x).Validation.AlertStyle
For y = 2 To TS_Nombre_Lignes(TS)
F = ""
F = TS.ListObject.DataBodyRange(y, x).Validation.Formula1 _
& TS.ListObject.DataBodyRange(y, x).Validation.InputMessage _
& TS.ListObject.DataBodyRange(y, x).Validation.AlertStyle
If F <> FF Then
TS.ListObject.DataBodyRange(y, x).Select
TS_EstValide = False
FF = FF & F
Exit For
End If
If TS_EstValide = False Then Exit For
Next y
Next x
End If

' Restaure la configuration d'origine:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Cursor = xlDefault
On Error GoTo 0

' Message pour informer s'il y a une erreur:
If TS_EstValide = False Then
Select Case FF
Case Is = "": MsgBox "Cette valeur ne correspond pas aux restrictions de validation des données pour cette cellule.", vbCritical
Case Else: MsgBox "Cette cellule n'a pas les mêmes restrictions de validation des données que la cellule précédente.", vbCritical
End Select
Else
Sheets(Feuille).Activate
End If

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

XV - Annexe 4 – Gestion des statuts

Cette annexe reprend des fonctions que vous retrouverez dans le module module « TS_Statuts » du fichier en pièce jointe.
Elles vous aideront à accélérer les traitements et à afficher une barre de progression.

XV-A - Annexe 4A – Gestion des statuts pour accélérer les traitements

Pour accélérer l’exécution des traitements dans Excel, par exemple dans une boucle qui provoque la modification des données d’un tableau, il est recommandé de désactiver la mise à jour des affichages à l’écran par l’instruction Application.ScreenUpdating = False.
Ainsi que l’actualisation automatique des calculs : Application.Calculation = xlCalculationManual.
Eventuellement suspendre les événements « sur changement, sur calcul… » : Application.EnableEvents = False.
Et pour informer qu’un traitement est en cours vous mettrez le curseur de la souris en forme d’attente avec Application.Cursor = xlWait.
Astuce, vous pouvez aussi désactiver la possibilité pour l’utilisateur d’interrompre le code VBA par la touche [Echap] avec Application.EnableCancelKey = xlDisabled.

Vous restaurerez ces statuts à la fin du traitement.

Pour vous simplifier la vie, vous trouverez dans le module « TS_Statuts » du fichier en pièce jointe les fonctions :
- Statuts_Mémoriser(MesStatuts), pour mémoriser les statuts actuels dans une variable « MesStatuts » préalablement déclarée en type personnalisé « TypeStatuts ».
- Statuts_Bloquer, qui bloque les statuts comme nous venons de le voir.
- Statuts_Restaurer(MesStatuts), pour restaurer les statuts à leur état initial.
J’ai aussi prévu la fonction Statuts_Initialiser pour forcer la remise à zéro des statuts, au cas où.

Exemple d’appel :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------------
' Mémorisation des statuts actuels :
Dim MesStatuts As TypeStatuts
Call Statuts_Mémoriser(MesStatuts)

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

' Traitement qui nécessite de bloquer les statuts :
Call Statuts_Bloquer

' ... Votre traitement...

' Restaure les statuts :
Call Statuts_Restaurer(MesStatuts)

' Traitement qui ne nécessite pas de bloquer les statuts :

' ... Votre traitement...

' Fin du traitement :
Gest_Err:
Call Statuts_Restaurer(MesStatuts)
If Err.Number <> 0 Then MsgBox "Erreur : " & Err.Number & " - " & Err.Description, vbCritical

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

Ou plus simplement, si vos statuts personnels sont ceux par défaut il n’est pas nécessaire de les mémoriser :

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------------
' Gestion des erreurs :
Err.Clear
On Error GoTo Gest_Err

' Traitement qui nécessite de bloquer les statuts :
Call Statuts_Bloquer

' ... Votre traitement...

' Restaure les statuts :
Call Statuts_Initialiser

' Traitement qui ne nécessite pas de bloquer les statuts :

' ... Votre traitement...

' Fin du traitement :
Gest_Err:
Call Statuts_Initialiser
If Err.Number <> 0 Then MsgBox "Erreur : " & Err.Number & " - " & Err.Description, vbCritical

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

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Type TypeStatuts
mEnableEvents As Boolean
mScreenUpdating As Boolean
mCalculation As Long
mCursor As Long
mEnableCancelKey As Boolean
mStatusBar As String
End Type

'------------------------------------------------------------------------------------------------------
Public Sub Statuts_Mémoriser(MesStatuts As TypeStatuts)
'------------------------------------------------------------------------------------------------------
MesStatuts.mEnableEvents = Application.EnableEvents
MesStatuts.mScreenUpdating = Application.ScreenUpdating
MesStatuts.mCalculation = Application.Calculation
MesStatuts.mCursor = Application.Cursor
MesStatuts.mEnableCancelKey = Application.EnableCancelKey
MesStatuts.mStatusBar = IIf(Application.StatusBar = False, "", Application.StatusBar)
End Sub

'------------------------------------------------------------------------------------------------------
Public Sub Statuts_Bloquer()
'------------------------------------------------------------------------------------------------------
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.Cursor = xlWait
Application.EnableCancelKey = xlDisabled
Application.StatusBar = ""
End Sub

'------------------------------------------------------------------------------------------------------
Public Sub Statuts_Restaurer(MesStatuts As TypeStatuts)
'------------------------------------------------------------------------------------------------------
Application.EnableEvents = MesStatuts.mEnableEvents
Application.ScreenUpdating = MesStatuts.mScreenUpdating
Application.Calculation = MesStatuts.mCalculation
Application.Cursor = MesStatuts.mCursor
Application.EnableCancelKey = MesStatuts.mEnableCancelKey
Application.StatusBar = MesStatuts.mStatusBar
End Sub

'------------------------------------------------------------------------------------------------------
Public Sub Statuts_Initialiser()
'------------------------------------------------------------------------------------------------------
Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.Cursor = xlDefault
Application.EnableCancelKey = xlInterrupt
Application.DisplayStatusBar = True
Application.StatusBar = ""
End Sub
'------------------------------------------------------------------------------------------------

XV-B - Annexe 4B – Une barre de progression qui s’affiche dans la barre d’état

Une barre de progression est un bon outil pour informer l’utilisateur de l’avancement d’un traitement et le faire patienter.
Le VBA n’en disposant pas, il faut passer par un formulaire que vous développerez ou que vous glanerez sur Internet.
Je vous propose ici une autre approche qui utilise la barre d’état pour afficher en bas à gauche de l’application une barre de progression. La progression est symbolisée par un carré plein qui remplace un carré vide.

La fonction Statuts_Progression, que vous trouverez dans le module « TS_Statuts » du fichier en pièce jointe, permet aussi : de personnaliser le texte affiché, d’afficher ou non le pourcentage de progression (en chiffres), de définir le nombre d’éléments qui constituent la barre de progression (de 0 à 50), d’afficher une seconde barre de progression à la suite de la première.

Ses arguments sont :

- Pourcentage : Le pourcentage de la progression (entre 0.01 et 1). Si 0 (False) alors efface la barre ;

- TailleBarre : (facultatif) Nombre d'éléments qui constituent la barre de progression (de 0 à 50), soit un pas maximum de 2%. Valeur par défaut = 10 éléments soit un pas de 10%. Si TailleBarre vaut 0 alors aucune barre n'est affichée ;

- Libellé : (facultatif) Libellé qui précède la barre de progression si SecondPourcentage = False (valeur par défaut) ou qui le suit si SecondPourcentage = True ;

- AfficherPourcentage : (facultatif) Si True (valeur par défaut) alors affiche à la suite du libellé le pourcentage de progression sans virgule (non géré si SecondPourcentage = True) ;

- SecondPourcentage : (facultatif) Si True alors affiche à la suite de la barre de progression active une seconde barre (valeur par défaut = False). TailleBarre peut être d'une taille différente de la première barre.

La fonction renvoie : True si la barre de progression est actualisée.

Exemples d’appel et du rendu obtenu :

Call Statuts_Progression(0.5) => Affiche "50%" suivi d'une barre de 10 éléments.
Call Statuts_Progression(0.5, Libellé:="Progression : ") => Affiche "Progression : 50%" suivi d'une barre de 10 éléments
Call Statuts_Progression(0.4, 20, "Image 4/" & i, , True) => Affiche à la suite une barre de 20 éléments et le libellé "Image 4/10" (où i vaut 10).
Call Statuts_Progression(0.5, Libellé:="Progression : ", TailleBarre:=0) => Affiche juste "Progression : 50%" sans afficher de barre.

Représentation de la barre de progression suivant les 4 appels

Remarques :
- Pour effacer la barre d’état : Call Statuts_Progression(False).
- Application.DisplayStatusBar est forcé à True pour afficher la barre d'état.
- Si la fenêtre n'est pas assez large le texte et la barre de progression ne s'affichent pas.
- C'est pourquoi ActiveWindow.Width est forcé à un minimum de 650 points.

Cliquez sur « Afficher le code » pour voir le code de la fonction

'------------------------------------------------------------------------------------------------
Public Function Statuts_Progression(ByVal Pourcentage As Double, _
Optional ByVal TailleBarre As Byte = 10, _
Optional ByVal Libellé As String = "", _
Optional AfficherPourcentage As Boolean = True, _
Optional SecondPourcentage As Boolean = False) As Boolean
'------------------------------------------------------------------------------------------------------
' Affiche une barre de progression en bas à gauche de l'écran.
'------------------------------------------------------------------------------------------------------
' Pourcentage : Pourcentage de la progression (entre 0.01 et 1). Si 0 (False) alors efface la barre.
' TailleBarre : (facultatif) Nombre d'éléments qui constituent la barre de progression (de 0 à 50)
'               soit un pas maximum de 2%. Valeur par défaut = 10 éléments soit un pas de 10%.
'               Si TailleBarre vaut 0 alors aucune barre n'est affichée.
' Libellé : (facultatif) Libellé qui précède la barre de progression.
' AfficherPourcentage : (facultatif) Si True (valeur par défaut) alors affiche à la suite du libellé le
'                       pourcentage de progression sans virgule.
' SecondPourcentage : (facultatif) Si True alors affiche à la suite de la barre de progression active une
'                     seconde barre (valeur par défaut = False). TailleBarre peut être d'une taille
'                     différente de la première barre. AfficherPourcentage n'est pas géré et Libellé s'affiche
'                     à la suite de la seconde barre.
'------------------------------------------------------------------------------------------------------
' La fonction renvoie : True si la barre de progression est actualisée.
'------------------------------------------------------------------------------------------------------
' Exemples d'appels:
'Call Statuts_Progression(0.5) => Affiche "50%" suivi d'une barre de 10 éléments.
'Call Statuts_Progression(0.5, Libellé:="Progression : ") => Affiche "Progression : 50%" suivi d'une barre de 10 éléments
'Call Statuts_Progression(0.4, 20, "Image 4/" & i, , True) => Affiche à la suite une barre de 20 éléments et le libellé (où i vaut 10).
'Call Statuts_Progression(0.5, Libellé:="Progression : ", TailleBarre:=0) => Affiche juste "Progression : 50%" sans afficher de barre.
'------------------------------------------------------------------------------------------------------
' Remarques : Application.DisplayStatusBar est forcé à True pour afficher la barre d'état.
'             Si la fenêtre n'est pas assez large le texte et la barre de progression ne s'affichent pas.
'             C'est pourquoi ActiveWindow.Width est forcé à un minimum de 650 points.
'------------------------------------------------------------------------------------------------------
Static Pc1 As Double
Static Pc2 As Double
Static AncBarre As String
Dim i As Integer
Dim Barre As String

' Si Pourcentage = 0 (False) alors ferme la barre:
If Pourcentage = 0 And SecondPourcentage = False Then Application.StatusBar = False: Pc1 = 0: Pc2 = 0: Exit Function

' Si pas de progression par rapport au dernier appel alors sort (et renvoie False):
If Round(Pourcentage, 2) = Round(Pc1, 2) And Round(Pourcentage, 2) = Round(Pc2, 2) Then Exit Function

' Gestion des débordements:
If Pourcentage > 1 Then Pourcentage = 1
If Pourcentage < 0 Then Pourcentage = 0
If TailleBarre > 50 Then TailleBarre = 50
If TailleBarre < 0 Then TailleBarre = 0

' Création de la barre de progression:
i = TailleBarre * Pourcentage
Barre = String(i, ChrW(9632)) ' Carré plein.
Barre = Barre & String(TailleBarre - i, ChrW(9634)) ' Carré vide.

' Affiche la première ou la seconde barre:
If SecondPourcentage = False Then
' Ajustement en tenant compte des espaces:
If AfficherPourcentage = True Then
If Round(Pourcentage, 2) < 0.1 Then Barre = "  " & Barre
If Round(Pourcentage, 2) < 1 Then Barre = "  " & Barre
End If
' Affiche le libellé et la barre:
Libellé = Libellé & " " & IIf(AfficherPourcentage = True, (Format(Pourcentage, "0%")) & "    ", "") & Barre
If TailleBarre = 0 Then Libellé = RTrim(Libellé)
' Mémorise la barre:
AncBarre = Libellé
Pc1 = Pourcentage
Pc2 = Pourcentage
Else
Libellé = AncBarre & " // " & Barre & IIf(Libellé <> "", "  " & Libellé, "")
Pc2 = Pourcentage
End If

' Configure la barre d'état pour l'affichage:
Dim AncScreenUpdating As Boolean
AncScreenUpdating = Application.ScreenUpdating
If Application.ScreenUpdating = False Then Application.ScreenUpdating = True
If Application.DisplayStatusBar = False Then Application.DisplayStatusBar = True
On Error Resume Next
If ActiveWindow.Width < 650 Then ActiveWindow.Width = 650
On Error GoTo 0

' Affiche la barre d'état (si largeur suffisante):
Application.StatusBar = Libellé

' Restaure le mode Application.ScreenUpdating d'origine s'il était à False:
If AncScreenUpdating = False Then Application.ScreenUpdating = False

' Renvoie Vrai:
Statuts_Progression = True

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

XVI - Annexe 5 – les variables publiques et les énumérations du module

Pour compléter les codes présentés, voici les variables publiques et les énumérations utilisées, déclarées en en-tête du module :

'------------------------------------------------------------------------------------------------
Public TS_Err_Number As Long
Public TS_Err_Description As String

Private TS_Méthode_Err As Integer

Private Cnn_TS As Variant ' => ADODB.Connection en liaison anticipée avec Microsoft ActiveX Data Objects 6.1 Library
Private Const Provider_ACCDB As String = "Microsoft.ACE.OLEDB.12.0"

Public Enum Enum_InfoTS
TS_Valeur
TS_Formule
TS_CouleurTexte
TS_CouleurFond
TS_Gras
TS_Italique
TS_Visible
TS_Commentaire
TS_Format
TS_LienHypertexte
TS_ImageCommentaireJPG
TS_Ajouter
TS_Soustraire
TS_Multiplier
TS_Diviser
TS_ViderMémoire
End Enum

Public Enum Enum_ImportationTS
TS_Ajout_Forcé
TS_MAJ_Uniquement
TS_MAJ_Ou_Ajout
TS_IgnorerSiExiste
End Enum

Public Enum Enum_ExportationTS
TS_XLSX
TS_CSV
TS_BMP
TS_JPG
TS_PDF
End Enum

Public Enum Enum_CopierDonnées
TS_RemplacerDonnées
TS_AjouterDonnées
End Enum

Public Enum Enum_ValeursOuFormules
TS_Valeurs
TS_Formules
TS_FormulesLocales
End Enum

Public Enum Enum_ModifierSQL
TS_Update_Valeur
TS_Update_Ajouter
TS_Update_Soustraire
TS_Update_Multiplier
TS_Update_Diviser
End Enum

Public Enum Enum_FormatSQL
TS_Standard
TS_Chaine
TS_Date
TS_Numérique
End Enum

Public Enum Enum_Gestion_Err
TS_Générer_Erreur
TS_MsgBox_Erreur
TS_Ignorer_Erreur
End Enum

Public Enum Enum_Renvoi_Recherche
TS_Recherche_Premiere_Valeur
TS_Recherche_Premiere_Ligne
TS_Recherche_Toutes_Valeurs
TS_Recherche_Toutes_Lignes
End Enum

Public Enum Enum_TS_Aligner
TS_Aligner_Données = 2
TS_Aligner_Entete = 4
TS_Aligner_Total = 8
End Enum
'------------------------------------------------------------------------------------------------

(1) https://docs.microsoft.com/fr-fr/office/vba/api/excel.xlautofilteroperator et aussi https://docs.microsoft.com/fr-fr/office/vba/api/excel.range.autofilter, https://excel.developpez.com/faq/?page=Filtre