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

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

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.

Article lu   fois.

L'auteur

Profil ProSite personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

I. Introduction

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

Pierre Fauconnier y consacre un tutoriel très complet 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 le nom de sa colonne 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 ».

Cette documentation a été réalisée avec Excel 2016 version 32 bits sous Windows 10.



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 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 « TS_ » comme il m'a été fait remarqué dans la discussion liée à cette documentation.

Une autre approche est d'afficher le message d'erreur directement dans la fonction où s'est produite l'erreur. Ce qui dispense le programmeur de cette tâche mais peut bloquer le traitement sur une erreur qui, dans certains cas, est sans conséquence pour la suite du programme.

Deux méthodes de gestion des erreurs, chacune avec ses avantages et ses inconvénients, que la fonction TS_SiErreur paramètre en permettant au choix d'afficher ou non un message d'erreur dans la fonction.

Ses arguments sont :

  • MsgBox_TS : indique s'il faut ou non afficher la boîte de dialogue en cas d'erreur, suivant l'énumération personnelle Enum_MsgBox_TS :
       - TS_AfficherMsgBox = affiche la boîte (valeur par défaut),
       - TS_MasquerMsgBox = n'affiche pas la boîte ;
  • Titre : (facultatif) le titre de la boîte de dialogue. Si vide alors affiche le nom de la fonction.

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

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
Public Function TS_SiErreur(MsgBox_TS As Enum_MsgBox_TS, Optional Titre As String = "")
'------------------------------------------------------------------------------------------------
' Paramètre s'il faut afficher ou non une boîte de dialogue en cas d'erreur.
'------------------------------------------------------------------------------------------------
' MsgBox_TS : Indique s'il faut ou non afficher la boîte de dialogue en cas d'erreur, suivant l'énumération Enum_MsgBox_TS:
'             TS_AfficherMsgBox = affiche la boîte (par défaut).
'             TS_MasquerMsgBox = n'affiche pas la boîte.
' Titre : Titre de la boîte de dialogue. Si vide alors affiche le nom de la fonction.
'------------------------------------------------------------------------------------------------
Select Case MsgBox_TS
    Case TS_AfficherMsgBox: TS_MasqueMsgBox = False
    Case TS_MasquerMsgBox: TS_MasqueMsgBox = True
End Select
TS_MsgBoxTitre = Titre
End Function
'------------------------------------------------------------------------------------------------



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) :

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


Image non disponible



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"


Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_ConvertirPlageEnTS")
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 » :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

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.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_CréerUnTableau")
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 » :

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


Image non disponible

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)



Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerLeTableau")
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.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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éclanché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.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

Remarque : pour simplifier vos traitements, nommez vos colonnes en évitant les caractères spéciaux « arobase, dièse, 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.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_ChangerLibellé")
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 » :

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


Ou :

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



Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_EffacerUneLigne")
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 » :

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


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_EffacerToutesLignes")
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 » :

 
Sélectionnez
------------------------------------------------------------------------------------------------
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------------------------------------------------------------------------------------------------


Image non disponible

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.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
 
' 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 ' Si le tableau est vierge alors il faut l'initialiser:
        If TS.ListObject.ListRows.Count = 0 Then
            Set TS = TS.ListObject.ListRows.Add.Range
        Else
            ' Ajoute une ligne en bas du tableau:
            TS.ListObject.ListRows.Add
        End If
        TS_AjouterUneLigne = True
        
    Case 1 To TS.ListObject.ListRows.Count ' Ajoute dans le tableau
        TS.ListObject.ListRows.Add Ligne
        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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_AjouterUneLigne")
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 » :

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


Image non disponible

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.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerUneLigne")
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 » :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerPlusieursLignes")
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 » :

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


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerToutesLignes")
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.

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then TS_SupprimerLignesVisibles = -1
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerLignesVisibles")
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.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then TS_SupprimerLignesMasquées = -1
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerLignesMasquées")
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 » :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim TS As Range
Set TS = Range("TS_Eleves")
Call TS_SupprimerDoublons(TS, "B") ' Supprime les doublons de la colonne nommée B
Call TS_SupprimerDoublons(TS, Array("B", "E")) ' idem mais si doublons en colonnes B et E.
Call TS_SupprimerDoublons(TS, 0) ' Supprime les doublons de la dernière colonne.
Call TS_SupprimerDoublons(TS, Array("B", 0)) ' idem mais si doublons en colonnes B et dernière colonne.
End Sub
'------------------------------------------------------------------------------------------------
 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerDoublons")
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 » :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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ù inserer 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(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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_AjouterUneColonne")
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 » :

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


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerUneColonne")
Err.Clear

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



II-S. 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é :


Image non disponible

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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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) :

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


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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é.
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_OptionsStyle")
Err.Clear

Exit Function

Poser_Filtre:
TS.ListObject.Range.AutoFilter
Resume Next

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



II-T. 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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

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

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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é.
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_DéfinirTotaux")
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------



II-U. 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;
  • FormatNumérique : le format numérique à appliquer.

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

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


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
Public Function TS_FormatColonne(TS As Range, _
                                 ByVal Colonne As Variant, _
                                 FormatNumérique As String) 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é.
' FormatNumérique : Le format à appliquer à la colonne.
'------------------------------------------------------------------------------------------------
' 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")
'------------------------------------------------------------------------------------------------
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
 
' Pose le format:
TS.ListObject.ListColumns(Colonne).DataBodyRange.NumberFormat = FormatNumérique

' Renvoie VRAI:
TS_FormatColonne = True
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_FormatColonne")
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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 Gest_Err

' 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

' Renvoie Vrai:
TS_TrierUneColonne = True
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If TS_TrierUneColonne = False And (Colonne < 0 Or Colonne > TS.ListObject.ListColumns.Count) Then _
    TS_Err_Description = "La colonne [" & Colonne & "] n'est pas inclue dans le tableau."
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_TrierUneColonne")
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 :

 
Sélectionnez
------------------------------------------------------------------------------------------------
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é.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_EffacerTri")
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.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Filtres_Effacer")
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.
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 » :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

Exemple pour supprimer tous ces filtres :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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é.
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Filtres_Poser")
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 :

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


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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é.
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Filtres_Effacer")
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 :

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


Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number = 0 Then TS_Filtres_Restaurer = True
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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

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 :

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

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



Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
 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 struturé à 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 = xlDefault
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_CouleurLigneChangeValeur")
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.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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é.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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) :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 = (Personalisé) 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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_ValeurColonne")
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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_InfoCellule")
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) :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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)

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 IsNumeric(Valeur(ik)) = True 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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Rechercher")
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.

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 : recherche dans les formules.

La fonction renvoie : le numéro de la première ligne trouvée ou zéro 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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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.

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
Public Function TS_RechercherVisible(TS As Range, _
                                     ByVal Colonne As Variant, _
                                     ValeurCherchée As Variant, _
                                     RespecterCasse As Boolean, _
                                     ValeursOuFormules As Enum_ValeursOuFormules) As Long
'-----------------------------------------------------------------------------------------------
' 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.
'-----------------------------------------------------------------------------------------------
' Renvoie : Le numéro de la 1ère ligne trouvée ou 0 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
'------------------------------------------------------------------------------------------------
Dim Rg As Range
Dim Lookin As Long

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

' Recherche par formule ou valeur:
Select Case ValeursOuFormules
    Case TS_Valeurs: Lookin = xlValues
    Case TS_Formules: 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

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

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Rechercher")
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.

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

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


Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
Public Function TS_Remplacer(TS As Range, _
                             ByVal Colonne As Variant, _
                             ValeurCherchée As Variant, _
                             ValeurRemplacement As Variant, _
                             RespecterCasse As Boolean) 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.
'-----------------------------------------------------------------------------------------------
' 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:
'    Dim TS As Range
'    Set TS = Range("TS_X")
'    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

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

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Remplacer")
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.
 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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.			
'------------------------------------------------------------------------------------------------


Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Sélectionner")
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 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 ligne ligne des totaux ;
  • pour ne renvoyer que les données visibles du Tableau Structuré.


 
Sélectionnez
'------------------------------------------------------------------------------------------------
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.Rows.Count = nombre le lignes, r.Columns.Count = nombre de colonnes, r.Cells(1, 1).Value = valeur cellule.
End Sub
'------------------------------------------------------------------------------------------------


Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
    If VisibleUniquement = True Then
        Set TS_Range = r.SpecialCells(xlCellTypeVisible)
    Else
        Set TS_Range = r
    End If
End If

TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Range")
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).

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.
 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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) 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.
'------------------------------------------------------------------------------------------------
' 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

' 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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_ModifCellule")
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------



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 mettre la valeur "Ok" dans la colonne "Admis" pour les élèves dont la note est suppérieure ou égale à 10 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 à utliser.
' VisibleUniquement : Si VRAI ne traite que les lignes visibles.
'------------------------------------------------------------------------------------------------------
Dim r As Range
Dim AncCalculation

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

' Bloque les calculs:
AncCalculation = Application.Calculation
Application.Calculation = xlCalculationManual

' 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 n'est pas filtré:
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 a une car ListColumns réagit
' différement sur les cellules visibles ou non suivant que la feuille
' est active ou non:
Else

    ' Renvoie un Range de la colonne:
    Set r = TS_Range(TS, VisibleUniquement, Colonne)
    If Not r Is Nothing Then
        Dim Rg As Range
        ' Modifie la valeur des cellules:
        For Each Rg In r: Rg.Value = Valeur: Next
        ' Renvoie VRAI:
        TS_ForcerValeurColonne = True
    End If

End If

' Fin du traitement:
Gest_Err:
' Restaure les calculs:
Application.Calculation = AncCalculation
' Erreurs:
If Err.Number = 1004 Then Err.Clear
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_ForcerValeurColonne")
Err.Clear

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



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

Les fonctions présentées ici permettent d'importer ou d'exporter des données. Depuis et vers Excel mais aussi depuis et vers Access.

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) :


Image non disponible

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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 :


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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'exite 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
        ' 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)
    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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_ImporterDonnées")
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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
If TS_ImporterDonnées(TS_Destination, Tableau, TS_MAJ_Ou_Ajout, True, "Nom") = False Then
    Err.Raise TS_Err_Number, , TS_Err_Description
End If

' Tri de la colonnne :
If TS_TrierUneColonne(TS:=TS_Destination, _
                      Colonne:="Nom", _
                      Méthode:=xlSortOnValues, _
                      Ordre:=xlAscending, _
                      EffacerAncienTri:=True) = False Then
    Err.Raise TS_Err_Number, , TS_Err_Description
End If

' Gestion des erreurs :
Gest_Err:
If Err.Number <> 0 Then MsgBox Err.Number & " : " & Err.Description, vbCritical, Err.Source

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


Ce qui donne :


Image non disponible



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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

Remarque : vous trouverez en annexe un code VBA pour fusionner deux fichiers PDF si vous disposez de l’application « Adobe Acrobat Pro ».

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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)
    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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_ExporterEnFichier")
Err.Clear
 
' S'il faut ouvrir le fichier:
If TS_ExporterEnFichier = True And OuvrirFichier = True _
    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). Laisser 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 :

 
Sélectionnez
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 :

 
Sélectionnez
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" :

 
Sélectionnez
Call TS_EnregistrerDansAccess(Range("TS_Eleves"), "P:\Test.accdb", "Table_1", "", Array("Nom", "Nom", "Prénom", "Prénom", ">Qui", Application.UserName), False)



Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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).
'                       Laisser 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 = xlDefault
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_EnregistrerDansAccess")
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 colones 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 language 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.

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) :

 
Sélectionnez
Call TS_ImporterDepuisAccess(Range("TS_Eleves"), "C:\Access\Ecole.accdb", "Eleves", "", "", "Note>10", TS_RemplacerDonnées)

Remarque : si besoin vous trouverez en Annexe 1 plus d'informations sur le language SQL.



Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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) 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 colones dans le tableau elles sont ajoutées.
' 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.
' 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.
'-----------------------------------------------------------------------------------------------
' 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 = xlDefault
Anc_StatusBar = Application.StatusBar
Application.StatusBar = "Connexion à la base Access [" & BaseAccess & "]..."
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

' 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 = "*"
MonRs.Open "SELECT " & ListeDesChamps & " FROM [" & TableAccess & "]" & IIf(SQLWhere > "", " WHERE " & SQLWhere, "") _
             , Cnn_TS, 1, 2, 1 ' => adOpenKeyset, adLockPessimistic, adCmdText

' Si des données existent:
If Not MonRs Is Nothing Then

    ' Efface les filtres existants:
    Call TS_Filtres_Effacer(TS)
    
    ' Initilalise 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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_ImporterDepuisAccess")
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 ;
  • SQLWhere : la requête d'instruction en language 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 (a utiliser avant d'y copier de nouveaux enregistrements en remplacement des anciens, voir le chapitre précédent) :

 
Sélectionnez
Call TS_RequeteBaseAccess("P:\Eleves.accdb"), "", "DELETE * FROM [T_Notes]")

Remarque : si besoin vous trouverez en Annexe 1 plus d'informations sur le language SQL.



Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
Public Function TS_RequeteBaseAccess(BaseAccess As String, MotDePasse As String, _
                                     SQLWhere 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.
' SQLWhere : 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 = xlDefault
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: " & SQLWhere, 99)
Cnn_TS.Execute SQLWhere

' 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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_RequeteBaseAccess")
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 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 (la feuille doit être active) ;
  • 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 ;
  • Ligne_Dest : ligne où commencer la copie, par exemple 1 pour copier à la premiere ligne du tableau, ou 0 pour la dernière ligne du tableau ;
  • Méthode : énumération XlCellType par défaut xlCellTypeVisible pour les cellules visibles uniquement.

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

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 Méthode As XlCellType = xlCellTypeVisible) 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).
' 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 premiere ligne du tableau,
'              ou 0 pour la dernière ligne du tableau.
' Méthode : énumération XlCellType (https://learn.microsoft.com/fr-fr/office/vba/api/excel.xlcelltype).
'           par défaut xlCellTypeVisible pour les cellules visibles uniquement.
'------------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' 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.
'------------------------------------------------------------------------------------------------------
' 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
 
' 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

' 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

' Copie les données:
TS_Source.ListObject.ListColumns(Colonne_Source).DataBodyRange.SpecialCells(Méthode).Copy

' Colle les données (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
Call TS_Sélectionner(TS_Dest, Colonne_Dest, Ligne_Dest)
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

' 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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_CopierUneColonne")
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 » :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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

' 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

' 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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_CopierValeurColonne")
Err.Clear

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



VI-I. 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.

Ses arguments sont :

  • TS_Source : la plage (de type Range) du tableau structuré source ;
  • 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).

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):

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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é dans un autre tableau structuré.
'------------------------------------------------------------------------------------------------------
' TS_Source : le tableau structuré source.
' 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).
'------------------------------------------------------------------------------------------------------
' 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)
' - 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:
If TypeName(TS_Source) = "Range" Then
    Copie = TS_MémoriseTableau(TS_Source, ValeursOuFormules)
Else
    Copie = TS_Source
End If

' 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_EffacerToutesLignes(TS_Dest)
        NbOrigine = 0
        
        ' Dimentionne 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))

        ' 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
        End Select
        
    Case TS_AjouterDonnées
    
        NbOrigine = TS_Nombre_Lignes(TS_Dest)
        TS_Dest.Cells(TS_Dest.Rows.Count + 1, 1).Resize(UBound(Copie), TS_Dest.Columns.Count) = Copie

End Select

' Renvoie le nombre de données copiées:
TS_CopierUnTableau = TS_Nombre_Lignes(TS_Dest) - NbOrigine

' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_CopierUnTableau")
Err.Clear

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



VI-J. 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.

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

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Image non disponible

Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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.
'------------------------------------------------------------------------------------------------------
' 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
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(Données(y, x)) = True Then Données(y, x) = CDec(Format(Données(y, x), "0.000000000000"))
            End If
        End If
    Next x
Next y

' 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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_MémoriseTableau")
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 celulle 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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------


Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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 coordoné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 celulle 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 est elle à l'intérieur du tableau (hors en-têtes et totaux):
    If y <= TS.Rows.Count And y > 0 Then
        Colonne = y
        Ligne = x
        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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_CelluleActive")
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 des exemples qui utilisent les requêtes SQL et devraient vous convaincre plus que de longs discours.

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 Pierre Fauconnier pour sa relecture technique, ses remarques pertinentes et la correction de mes erreurs et 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 : les chapitres suivants ont été ajoutés après la mise en ligne de cette documentation et n'ont pas été soumis à une relecture technique et orthographique : TS_SupprimerLignesVisibles, TS_SupprimerLignesMasquées, TS_SupprimerDoublons, TS_CouleurLigneChangeValeur, TS_ForcerValeurColonne, TS_EnregistrerDansAccess, TS_CopierUneColonne, TS_CopierUnTableau, TS_MémoriseTableau, TS_FormatColonne, TS_RequeteBaseAccess, TS_SiErreur, TS_RechercherVisible, TS_Remplacer, TS_Range, TS_ForcerValeurColonne, TS_ImporterDepuisAccess, TS_CelluleActive, TS_Filtres_Existe, TS_CopierValeurColonne.
Si vous constatez des erreurs merci de les signaler dans cette discussion.

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.

Pour simplifier la saisie de votre code, pensez à utiliser la notation pointée « TS. » qui affiche l’ensemble des fonctions du module :


Image non disponible



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

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

Pour rechercher, exporter ou 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 : le tableau structuré doit faire moins de 256 colonnes sur 65536 lignes, les ingénieurs de Microsoft ont dû oublier qu’Excel depuis quelques années est monté en puissance.

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

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



XI-B. TS_RequeteSQL

La fonction TS_RequeteSQL exécute une requête SQL sur un tableau structuré et renvoie un jeu d’enregistrements.

Ses arguments sont :

  • TS : la plage (de type Range) qui représente le tableau structuré ;
  • StrChamps : le nom des champs à sélectionner (ceux qui alimenteront le jeu d’enregistrements) ;
  • StrSQL : (facultatif) la requête SQL des critères de sélection.

La fonction renvoie : un jeu d’enregistrements, ou Nothing si la requête ne sélectionne rien.

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 » sur la feuille 2 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Dim TS_Destination As Range
Dim Enr As Variant

' Suppression de l'éventuel ancien tableau :
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 structuré :
Set TS_Destination = TS_CréerUnTableau(Plage:=ThisWorkbook.Sheets("Feuil2").Range("A1"), _
                           Titres:="Nom", _
                           Nom:="Tableau_Noms", _
                           Style:="*")
                           
' Requête pour obtenir la liste des noms sans doublon et triée :
Set Enr = TS_RequeteSQL(Tableau, "[Nom]", "GROUP BY [Nom] ORDER BY [Nom]")

' Affiche la requête dans le tableau structuré :
If Not Enr Is Nothing Then
     Range(TS_Destination.ListObject).CopyFromRecordset Enr
End If

' Gestion des erreurs :
Gest_Err:
If Err.Number <> 0 Then MsgBox Err.Number & " : " & Err.Description, vbCritical, Err.Source

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

Remarques :

  • l’instruction SQL "GROUP BY [Nom] ORDER BY [Nom]" regroupe les noms sans doublon et les trie par ordre croissant ;
  • l’affichage dans le tableau structuré « TS_Destination » du jeu d’enregistrements « Enr » se fait avec l’instruction Range(TS_Destination.ListObject).CopyFromRecordset Enr.

Exemple pour obtenir la liste des trois meilleures notes et le nom et prénom des élèves concernés :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
...
' Création du tableau destination :
Set TS_Destination = TS_CréerUnTableau(Plage:=ThisWorkbook.Sheets("Feuil2").Range("A1"), _
                           Titres:=Array("Nom", "Prénom", "Note"), _
                           Nom:="Tableau_3_Meilleurs", _
                           Style:="*")
    
' Requête pour obtenir les élèves qui ont eu les 3 meilleures notes, classées par notes :
Set Enr = TS_RequeteSQL(Tableau, "TOP 3 [Nom],[Prénom],[Note]", "WHERE [Note] > 10 ORDER BY [Note] DESC")

' Affiche la requête dans le tableau structuré :
If Not Enr Is Nothing Then
    Range(TS_Destination.ListObject).CopyFromRecordset Enr
End If
...
'------------------------------------------------------------------------------------------------


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


Image non disponible

Exemple pour regrouper les notes par ordre décroissant et indiquer le nombre d’élèves concernés :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
...

' Création du tableau destination :
Set TS_Destination = TS_CréerUnTableau(Plage:=ThisWorkbook.Sheets("Feuil4").Range("A1"), _
                           Titres:=Array("Note", "Quantité"), _
                           Nom:="Tableau_X", _
                           Style:="*")
    
' Requête pour obtenir la liste des notes et la quantité d'élèves ayant eu cette note :
Set Enr = TS_RequeteSQL(Tableau, "[Note], Count([Note])", "GROUP BY [Note] ORDER BY [Note] DESC")

' Affiche la requête dans le tableau structuré :
If Not Enr Is Nothing Then
    Range(TS_Destination.ListObject).CopyFromRecordset Enr
End If

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


Image non disponible

Exemple pour ajouter 1 aux notes inférieures à 10 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
...
   
' 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.


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


Le code de la fonction :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
Public Function TS_RequeteSQL(TS As Range, StrChamps As String, _
                              Optional ByVal StrSQL As String = "") 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 : le tableau Structuré (ou la plage avec en-tête). Maxi = 65535 lignes et 255 colonnes. A1:IU65535
' StrChamps : Liste des champs (ou * ou vide pour tous).
' StrSQL : Requête SQL avec ses conditions.
'------------------------------------------------------------------------------------------------
' Renvoie : le jeu d'enregistrements sélectionné,
'           ou Nothing si rien n'est sélectionné (ou erreur).
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear

' Contrôle la taille du tableau:
If TS.ListObject.ListColumns.Count > 255 _
Or TS.ListObject.ListRows.Count > 65535 Then _
    Err.Raise vbObjectError, , "Taille du Tableau Structuré trop grande pour une requête SQL."

' 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 (ou la plage avec en-tête)
StrSQL = "SELECT " & IIf(StrChamps > "", StrChamps, "*") & " FROM [" & TS.Parent.Name & "$" _
         & TS.CurrentRegion.Address(False, False, xlA1) & "] " & StrSQL
 
' S'il y a des enregistrements concernés alors les renvoie:
Set TS_RequeteSQL = TS_ExecuterSQL(TS, StrSQL)
 
' Restaure l'affichage:
TS.ListObject.ShowHeaders = Anc_Entete
TS.ListObject.ShowTotals = Anc_Totaux
Application.ScreenUpdating = Anc_ScreenUpdating
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then Set TS_RequeteSQL = Nothing
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_RequeteSQL")
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.

 
Sélectionnez
'------------------------------------------------------------------------------------------------
Private Function TS_ExecuterSQL(TS As Range, 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)
'------------------------------------------------------------------------------------------------
Dim Cnn As Variant  ' Liaision anticipée => As ADODB.Connection
Dim Rs As Variant   ' Liaision 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") ' Liaision 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"";"
 
' Exécute une requête SQL sur un jeu d'enregistrements:
Set Rs = CreateObject("ADODB.Recordset") ' Liaision anticipée => Set Rs = New ADODB.Recordset
Rs.Open StrSQL, Cnn, 1, 2, 1 ' Liaision 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
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then Set TS_ExecuterSQL = Nothing
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_ExecuterSQL")
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------



XII. 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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------



XIII. Annexe 3 – 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 :

 
Sélectionnez
'------------------------------------------------------------------------------------------------
Public TS_Err_Number As Long
Public TS_Err_Description As String
Private TS_MasqueMsgBox As Boolean
Private TS_MsgBoxTitre As String
 
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
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
End Enum

Public Enum Enum_MsgBox_TS
    TS_AfficherMsgBox
    TS_MasquerMsgBox
End Enum
'------------------------------------------------------------------------------------------------



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



Licence Creative Commons
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 © 2022 Developpez.com.