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 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 descriptionErr
.Description
et d'afficher ou non une boîte de dialogue (nous détaillerons cela avec l'étude de la fonction TS_SiErreur) ; - d’être préfixées « TS_ » pour mieux les identifier.
Les débutants en VBA acquerront le niveau nécessaire avec le tutoriel « Tome 1 - Des bases de la programmation à l'algorithme de classement rapide QuickRanking ».
Les codes de cette documentation ont été réalisés avec Excel 2016 version 32 bits sous Windows 10. Ils sont compatibles avec la version 64 bits d'Excel 365.
II. Concevoir un tableau structuré▲
Les différentes fonctions de ce chapitre sont consacrées à la conception d’un tableau structuré.
Cela va de sa création à la gestion de ses options, en passant par l’effacement, l’ajout ou la suppression de lignes et colonnes.
Mais avant tout nous allons étudier comment sont gérées les erreurs dans les différentes fonctions.
II-A. TS_SiErreur▲
Les différentes fonctions que nous allons étudier ci-après renvoient pratiquement toutes une valeur d'exécution permettant d'identifier si le traitement s'est déroulé correctement, généralement True
si tout s’est bien passé ou False
ou -1 dans le cas contraire.
Dans tous les cas, une erreur de traitement alimente les variables publiques TS_ErrNumber et TS_ErrDescription avec respectivement le code de l’erreur Err
.Number
et sa description Err
.Description
.
Le programmeur peut donc savoir si une erreur s'est produite en analysant la valeur renvoyée par la fonction appelée, et afficher s'il le souhaite une boîte de dialogue pour décrire cette erreur en utilisant les variables TS_ErrNumber et TS_ErrDescription.
Ce qui peut être lourd à gérer dans une application faisant de nombreux appels aux fonctions comme il m'a été fait remarqué dans la discussion liée à cette documentation.
J’ai donc modifié la gestion des erreurs du module « TS » en conséquence et désormais trois possibilités sont offertes par la fonction TS_SiErreur pour paramétrer la façon dont vous souhaitez gérer les erreurs, en sélectionnant l’une des options suivantes dans son argument :
- TS_Générer_Erreur : (par défaut) la fonction renvoie l'erreur à la procédure appelante. Si celle-ci possède un gestionnaire d'erreurs validé, il est activé afin de gérer l'erreur, sinon le traitement est interrompu ;
- TS_MsgBox_Erreur : l’erreur n’est pas renvoyée à la fonction appelante mais une boîte de message signale l’erreur, et la fonction revoie un code d’erreur (
False
ou -1) ; - TS_Ignorer_Erreur : l’erreur est « ignorée », seul le code d'erreur renvoyé (
False
ou -1) permet de savoir qu’une erreur s’est produite.
Remarque : la fonction TS_SiErreur peut être appelée n'importe où dans votre programme et autant de fois que vous le désirez.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_SiErreur
(
TS_Gestion_Err As
Enum_Gestion_Err)
'------------------------------------------------------------------------------------------------
' Paramètre comment les erreurs doivent être gérées dans les fonctions de ce module.
'------------------------------------------------------------------------------------------------
' TS_Gestion_Err : Indique comment traiter une erreur, suivant l'énumération Enum_TS_Gestion_Err:
' TS_Générer_Erreur = (par défaut) renvoie l'erreur à la procédure appelante. Si elle possède un
' gestionnaire d'erreurs validé, il est activé afin de gérer l'erreur, sinon
' le traitement est interrompu.
' TS_MsgBox_Erreur = Affiche une boîte de message indiquant l'erreur et continue le traitement, mais
' la fonction renvoie un code d'erreur qui lui est propre (généralement False ou -1).
' TS_Ignorer_Erreur = Ignore l'erreur (la fonction renvoie un code d'erreur, généralement False ou -1).
'------------------------------------------------------------------------------------------------
TS_Méthode_Err =
TS_Gestion_Err
End
Function
'------------------------------------------------------------------------------------------------
Exemple avec un cas (théorique) où l’utilisateur sélectionne un fichier contenant un tableau structuré nommé « Tableau1 » à importer dans le classeur actif. Puis les données sont mises en forme et triées sur la colonne "Prenom" :
L’instruction Call
TS_SiErreur
(
TS_Ignorer_Erreur) permet d’ignorer les erreurs du module « TS ». Ainsi la fonction TS_ImporterDepuisClasseur renvoie False
en cas d’erreur sans bloquer la suite du traitement. L’utilisateur s’est simplement trompé de fichier, on lui demande s’il veut en sélectionner un autre.
On pourrait aussi utiliser On
Error
Resume
Next
avant l’appel de la fonction puis restaurer le gestionnaire d’erreur On
Error
GoTo
Gest_Err après. C’est à vous de choisir ce que vous préférez.
L’instruction Call
TS_SiErreur
(
TS_MsgBox_Erreur) affiche un message en cas d’erreur. Ici rien n’est bloquant, l’utilisateur a peut-être renommé la colonne « Date » en « Dates », peu importe car elle ne sera pas utilisée dans la suite du traitement, un message signale simplement cette anomalie (qu’il conviendra de corriger).
L’instruction Call
TS_SiErreur
(
TS_Générer_Erreur) branchera la procédure à l’étiquette Gest_Err en cas d’erreur. Si l’utilisateur a renommé la colonne « Prenom » en « Prénom » l’erreur est critique car cette colonne est utilisée pour diverses opérations, donc la procédure est terminée et un message affiche l’erreur.
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Dim
Fichier As
String
Dim
Moyenne As
Double
Set
Tableau =
Range
(
"Tableau1"
)
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Ne bloque pas le traitement en cas d'erreur, c'est jusque que l'utilisateur
' a sélectionné le mauvais fichier:
Call
TS_SiErreur
(
TS_Ignorer_Erreur)
Do
' Sélectionne un fichier Excel:
Fichier =
Application.GetOpenFilename
(
"Fichiers Excel,*.xls*"
)
' Importe les données dans un tableau structuré:
If
TS_ImporterDepuisClasseur
(
Fichier, ""
, "Tableau1"
, Tableau, TS_RemplacerDonnées, ""
) =
False
Then
' Si ce n'est pas le bon fichier alors le signaler:
If
MsgBox
(
"Voulez-vous sélectionner un autre fichier ?"
, vbQuestion
+
vbYesNo
, _
"Ce n'est pas le bon fichier"
) =
vbNo
Then
Exit
Sub
Fichier =
""
End
If
Loop
While
Fichier =
""
' Génère un message en cas d'erreur mais continue la traitement:
Call
TS_SiErreur
(
TS_MsgBox_Erreur)
' Format Numérique et format date:
Call
TS_FormatColonne
(
Tableau, "Note"
, "0.0"
, True
)
Call
TS_FormatColonne
(
Tableau, "Date"
, "dd/mm/yyyy"
)
' Branchement à l'étiquette "Gest_Err" si une erreur se produit dans les traitements
' du tableau:
Call
TS_SiErreur
(
TS_Générer_Erreur)
' Trie la colonne "Prenom":
Call
TS_TrierUneColonne
(
Tableau, "Prenom"
, xlSortOnValues, xlAscending, True
)
' Compte la moyenne des notes:
Moyenne =
TS_ValeurColonne
(
Tableau, "Note"
, xlTotalsCalculationAverage, False
)
' Autres traitements:
' ...
' Gestion des erreurs:
Gest_Err
:
If
Err
.Number
<>
0
Then
MsgBox
"Erreur dans la fonction : "
&
Err
.Source
&
vbCrLf
&
vbCrLf
_
&
Err
.Number
&
" : "
&
Err
.Description
, _
vbCritical
, "Exemple"
Err
.Clear
End
Sub
'------------------------------------------------------------------------------------------------
II-B. TS_ConvertirPlageEnTS▲
La fonction TS_ConvertirPlageEnTS convertit une plage de données classique en un tableau structuré.
Ses arguments sont :
- TD : la plage (de type Range) qui représente la plage de données à convertir ou tout simplement la première cellule haut/gauche de cette plage, car la plage sera étendue automatiquement ;
- Nom : (facultatif) le nom à donner au tableau structuré généré. Si l’argument n’est pas renseigné, le tableau prendra le nom attribué automatiquement par Excel ;
- Style : (facultatif) le nom du style du tableau structuré. Si l’argument n’est pas renseigné, le style par défaut sera appliqué. Si l’argument est vide, alors le tableau sera sans style ;
- AvecEntete : (facultatif) une valeur de l’énumération XlTotalsCalculation qui indique si la première ligne contient des en-têtes, soit l'une des valeurs suivantes :
- xlYes : (valeur par défaut) la plage contient des en-têtes,
- xlNo : la plage ne contient pas d'en-tête et Excel les rajoute,
- xlGuess : Excel détecte automatiquement si la plage contient ou non des en-têtes.
La fonction renseigne :
- Nom : le nom donné au tableau structuré, ce qui peut être utile si l’argument n’avait pas été renseigné pour connaître le nom attribué par Excel ;
- Style : le nom du style du tableau structuré, ce qui peut également être utile si l’argument n’avait pas été renseigné.
La fonction renvoie : un Range qui représente la plage du tableau structuré généré.
Exemple pour convertir la plage de données située en « A1 » de la feuille « Feuil3 » en un tableau structuré qui sera nommé « TS_Eleves » et de style « clair 13 » (ici la plage de type Range renvoyée n’est pas utilisée, mais nous étudierons des exemples où elle le sera, c’est pourquoi j’ai souhaité la représenter) :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
TS_ConvertirPlageEnTS
(
TD:=
Sheets
(
"Feuil3"
).Range
(
"A1"
), Nom:=
"TS_Eleves"
, _
Style:=
"TableStyleLight13"
, AvecEntete:=
xlYes)
End
Sub
'------------------------------------------------------------------------------------------------
Remarque : dans le code de cet exemple (et dans plusieurs autres de cette documentation), les arguments sont nommés pour vous faciliter la lecture, un appel plus court reste évidemment possible : Set
Tableau =
TS_ConvertirPlageEnTS
(
Sheets
(
"Feuil3"
).Range
(
"A1"
), "TS_Eleves"
, "TableStyleLight13"
)
Ou puisque le renvoi de la fonction n’est pas utilisé :Call
TS_ConvertirPlageEnTS
(
Sheets
(
"Feuil3"
).Range
(
"A1"
), "TS_Eleves"
, "TableStyleLight13"
)
Ou encore (sans l’instruction Call
) :
TS_ConvertirPlageEnTS Sheets
(
"Feuil3"
).Range
(
"A1"
), "TS_Eleves"
, "TableStyleLight13"
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ConvertirPlageEnTS
(
TD As
Range, _
Optional
ByRef
Nom As
String
=
""
, _
Optional
ByRef
Style As
String
=
"*"
, _
Optional
AvecEntete As
XlYesNoGuess =
xlYes) As
Range
'------------------------------------------------------------------------------------------------
' Transforme une plage classique en un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TD : La plage concernée (ou la cellule haut gauche) du tableau de données.
' Nom : Le nom à donner au tableau ou vide pour prendre le nom attribué par EXCEL.
' Style : Le style ou * pour le style par défaut ou vide pour aucun style.
' AvecEntete : Indique si la première ligne contient des en-têtes :
' xlYes : la plage contient des en-têtes;
' xlNo : la plage ne contient pas d'en-tête et Excel les rajoute;
' xlGuess : Excel détecte automatiquement si la plage contient ou non des en-têtes.
'------------------------------------------------------------------------------------------------
' Renvoie : La plage Range qui représente la plage du Tableau Structuré créé.
'------------------------------------------------------------------------------------------------
' Exemple :
' Dim TS As Range
' Set TS = ConvertirPlageEnTS(Range("K3"))
'------------------------------------------------------------------------------------------------
On
Error
GoTo
Gest_Err
Err
.Clear
' Si le TD n'existe pas déjà alors le créer:
If
TD.ListObject
Is
Nothing
Then
' Si TD ne représente qu'une seule cellule alors étend la plage:
If
TD.Count
=
1
Then
Set
TD =
TD.CurrentRegion
' Création du Tableau Structuré en attribuant le nom passé ou en prenant celui attribué par EXCEL:
If
Nom >
""
Then
TD.Parent.ListObjects.Add
(
xlSrcRange, TD, , AvecEntete).Name
=
Nom
Else
TD.Parent.ListObjects.Add
xlSrcRange, TD, , AvecEntete
End
If
' Modifie le style s'il ne faut pas prendre celui par défaut, ou pas de style si vide:
If
Style <>
"*"
Then
TD.Parent.ListObjects
(
TD.ListObject.Name
).TableStyle
=
Style
End
If
' Renseigne le nom du Tableau Structuré et son style:
Nom =
TD.ListObject.DisplayName
Style =
TD.Parent.ListObjects
(
TD.ListObject.Name
).TableStyle
' Renvoie la plage du Tableau Structuré:
Set
TS_ConvertirPlageEnTS =
TD
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ConvertirPlageEnTS"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ConvertirPlageEnTS"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-C. TS_CréerUnTableau▲
La fonction TS_CréerUnTableau crée un tableau structuré en utilisant les informations passées en arguments.
Ses arguments sont :
- Plage : la plage (de type Range) qui représente la première cellule haut/gauche où sera placé le tableau structuré ;
- Titres : les noms pour l'en-tête des colonnes, de format
Array
(
) c'est-à-dire entre guillemets et séparés par une virgule (voir l’exemple). Si le tableau n’a qu’une colonne, le titre peut être passé sous la formeString
; - Nom : (facultatif) le nom à donner au tableau structuré créé. Si l’argument n’est pas renseigné, le tableau prendra le nom attribué automatiquement par Excel ;
- Style : (facultatif) le nom du style du tableau structuré. Si l’argument n’est pas renseigné, le style par défaut sera appliqué. Si l’argument est vide, alors le tableau sera sans style.
La fonction renseigne les arguments :
- Nom : le nom donné au tableau structuré (utile si l’argument n’avait pas été renseigné) ;
- Style : le nom du style du tableau structuré (utile si l’argument n’avait pas été renseigné).
La fonction renvoie : un Range qui représente la plage du tableau structuré créé.
Si un tableau existait déjà à l’emplacement demandé, alors la fonction renvoie la plage de ce tableau.
Exemple pour créer un tableau structuré en « A1 » sur la feuille « Feuil3 » qui sera nommé « TS_Eleves » et de style « clair 13 » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
TS_CréerUnTableau
(
Plage:=
Sheets
(
"Feuil3"
).Range
(
"A1"
), _
Titres:=
Array
(
"Nom"
, "Prénom"
, "Note"
), _
Nom:=
"TS_Eleves"
, _
Style:=
"TableStyleLight13"
)
End
Sub
'------------------------------------------------------------------------------------------------
Remarque : le tableau est créé avec une ligne qui s'affiche dessous, mais reste vierge, la saisie peut commencer. En VBA, le tableau sera initialisé lors de l’ajout d’une première ligne, voir la fonction TS_AjouterUneLigne.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_CréerUnTableau
(
Plage As
Range, _
Titres As
Variant
, _
Optional
ByRef
Nom As
String
=
""
, _
Optional
ByRef
Style As
String
=
"*"
) As
Range
'------------------------------------------------------------------------------------------------
' Création d'un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Plage : La plage du tableau (ou juste la cellule Haut Gauche du tableau).
' Titres : Les titres pour l'en-tête, de format Array() c'est-à-dire entre guillemets et séparés par une virgule.
' S'il n'y a qu'une colonne à créer on peut la passer de la forme String (voir l'exemple).
' Nom : Le nom à donner au tableau ou vide pour prendre le nom attribué par EXCEL.
' Style : Le nom Excel du style ou * pour le style par défaut ou vide pour aucun style.
'------------------------------------------------------------------------------------------------
' Renvoie : La plage Range qui représente la plage du Tableau Structuré créé.
'------------------------------------------------------------------------------------------------
' Exemple d'utilisation:
' Dim TS As Range
' Set TS = TS_CréerUnTableau(Range("A1"), Array("Nom", "Prénom", "Note"), "Tableau_Eleves")
' S'il n'y a qu'un seul titre le Array n'est pas nécessaire:
' Set TS = TS_CréerUnTableau(Range("A1"), "Nom", "Tableau_Eleves")
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Si le tableau existe déjà alors le renvoyer:
If
Not
Plage.ListObject
Is
Nothing
Then
Nom =
Plage.ListObject.DisplayName
Style =
Plage.ListObject.TableStyle
Set
TS_CréerUnTableau =
Range
(
Plage.ListObject
)
Else
' Affiche les titres:
If
IsArray
(
Titres) =
True
Then
Plage.Resize
(
1
, UBound
(
Titres) +
1
).Value
=
Titres
Else
Plage.Value
=
Titres
End
If
' Conversion de la plage en un Tableau Structuré:
Set
TS_CréerUnTableau =
TS_ConvertirPlageEnTS
(
Plage, Nom, Style)
End
If
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_CréerUnTableau"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_CréerUnTableau"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-D. TS_SupprimerLeTableau▲
La fonction TS_SupprimerLeTableau supprime le tableau structuré passé en argument.
Son argument est :
- TS : la plage (de type Range) qui représente le tableau structuré à supprimer.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour supprimer le tableau structuré nommé « TS_Eleves » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Call
TS_SupprimerLeTableau
(
Range
(
"TS_Eleves"
))
End
Sub
'------------------------------------------------------------------------------------------------
Le nom d'un tableau structuré est unique dans un classeur. Il n'est donc pas nécessaire d'indiquer la feuille où il se trouve dans l'argument passé à la fonction car Excel sait l'identifier, sauf (la nuance est importante) s'il n'est pas dans le classeur actif. Dans ce cas il faut effectivement indiquer la feuille où il se trouve.
Pour cette documentation tous les tableaux structurés sont dans le classeur actif.
En pratique, pour simplifier l'emploi des fonctions, privilégiez l'usage d'une variable qui fait référence au tableau structuré.
Cela permet de ne déclarer la plage du tableau qu'une seule fois et donc de faciliter la maintenance du code.Dim
Tableau As
RangeSet
Tableau =
Range
(
"TS_Eleves"
)Call
TS_SupprimerLeTableau
(
Tableau)
Certain vont préférer passer en argument la plage du tableau sous sa forme « simplifiée » (c'est-à-dire le nom du tableau mis entre crochets) ce qui donne :Call
TS_SupprimerLeTableau
(
[TS_Eleves])
Chacun a ses habitudes de programmation et je vous laisse libre de faire comme bon vous semble.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_SupprimerLeTableau
(
TS As
Range) As
Boolean
'------------------------------------------------------------------------------------------------
' Suppression d'un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
On
Error
GoTo
Gest_Err
Err
.Clear
' Supprime le tableau:
TS.ListObject.Delete
TS_SupprimerLeTableau =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_SupprimerLeTableau"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_SupprimerLeTableau"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-E. TS_IndexColonne▲
La fonction TS_IndexColonne renvoie le numéro de la colonne passée en argument, qu’elle soit passée d’après son nom ou sa position. Cette fonction sera très utilisée par la suite, car nous accéderons à une colonne d’un tableau structuré principalement d’après son nom.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée.
La fonction renvoie : le numéro de la colonne concernée ou -1 en cas d’erreur.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_IndexColonne
(
TS As
Range, Colonne As
Variant
) As
Long
'------------------------------------------------------------------------------------------------
' Recherche le numéro de la colonne d'un tableau structuré.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : le numéro de la colonne ou le nom de la colonne.
' Si vide ou 0 alors renvoie le numéro de la dernière colonne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : Le numéro de la colonne dans le tableau, ou -1 si erreur.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' S'il faut traiter la dernière colonne:
If
Colonne =
""
Or
Colonne =
0
Then
Colonne =
TS.ListObject.ListColumns.Count
' Retrouve le numéro de la colonne si c'est le nom qui est passé en argument,
' une erreur des déclenchée si le nom n'existe pas:
If
TypeName
(
Colonne) =
"String"
Then
Colonne =
TS.ListObject.ListColumns
(
Colonne).Index
' Contrôle la cohérence de la colonne passée en argument:
If
Colonne <
0
Or
Colonne >
TS.ListObject.ListColumns.Count
Then
TS_IndexColonne =
-
1
Else
TS_IndexColonne =
Colonne
End
If
' Fin du traitement:
Gest_Err
:
If
Err
.Number
<>
0
Or
TS_IndexColonne =
-
1
Then
TS_IndexColonne =
-
1
TS_Err_Description =
"La colonne ["
&
Colonne &
"] n'est pas inclue dans le tableau."
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-F. TS_IndexLigne▲
La fonction TS_IndexLigne contrôle la cohérence de la ligne passée en argument.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Ligne : le numéro de la ligne concernée. Si ce nombre est zéro, alors la dernière ligne du tableau structuré est traitée.
La fonction renvoie : le numéro de la ligne concernée ou -1 en cas d’erreur.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_IndexLigne
(
TS As
Range, Ligne As
Long
) As
Long
'------------------------------------------------------------------------------------------------
' Contrôle la cohérence du numéro de la ligne passée en argument dans un tableau structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Ligne : le numéro de la ligne.
' Si vide ou 0 alors traite la dernière ligne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : le numéro de la ligne dans le tableau ou -1 si erreur.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' S'il faut traiter la dernière Ligne:
If
Ligne =
0
Then
Ligne =
TS.ListObject.ListRows.Count
' Contrôle la cohérence de la Ligne passée en argument:
If
Ligne <
0
Or
Ligne >
TS.ListObject.ListRows.Count
Then
TS_IndexLigne =
-
1
Else
TS_IndexLigne =
Ligne
End
If
' Fin du traitement:
Gest_Err
:
If
Err
.Number
<>
0
Or
TS_IndexLigne =
-
1
Then
TS_IndexLigne =
-
1
TS_Err_Description =
"La Ligne ["
&
Ligne &
"] n'est pas inclue dans le tableau."
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-G. TS_ChangerLibellé▲
La fonction TS_ChangerLibellé affiche un libellé personnalisé à la place du nom d’une colonne d’un tableau structuré, sans modifier le nom de cette colonne qui restera celui exploité dans les traitements.
Cette notion est très utile, car elle permet :
- de conserver un nom court pour désigner la colonne qui sera utilisée dans les traitements et les formules tout en affichant un texte plus explicite pour les utilisateurs ;
- d’éviter les caractères spéciaux dans le nom des colonnes (voir la remarque ci-dessous) ;
- d’adapter le libellé affiché au souhait de l’utilisateur sans avoir à modifier le code déjà écrit ;
- de faciliter le portage d’une application dans une autre langue.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée ;
- Libellé : le libellé à afficher à la place du nom ou vide pour restaurer le nom d'origine.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour modifier l’affichage des colonnes « Nom », « Prénom » et « Note » du tableau structuré nommé « TS_Eleves », en forçant un retour à la ligne par vbCrLf
:
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_ChangerLibellé
(
Tableau, "Nom"
, "Nom de"
&
vbCrLf
&
"l'élève"
)
Call
TS_ChangerLibellé
(
Tableau, "Prénom"
, "Prénom de"
&
vbCrLf
&
"l'élève"
)
Call
TS_ChangerLibellé
(
Tableau, 0
, "1ère"
&
vbCrLf
&
"Note"
)
End
Sub
'------------------------------------------------------------------------------------------------
Pour simplifier vos traitements, nommez vos colonnes en évitant les caractères spéciaux « arobase, dièse (croisillons), tabulation, saut de ligne, virgule, point, crochets, apostrophe, , ... », qui nécessitent dans les formules l’usage de crochets supplémentaires ou d'être précédés d'une apostrophe (simple quote).
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ChangerLibellé
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
Libellé As
String
) As
Boolean
'------------------------------------------------------------------------------------------------
' Change l'affichage de l'en-tête dans un Tableau Structuré, mais pas son nom.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Libellé : le libellé à afficher à la place du nom du champ, ou vide pour le nom d'origine.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Affiche l'en-tête et change le libellé:
TS.ListObject.ShowHeaders
=
True
If
Libellé <>
""
Then
TS.ListObject.HeaderRowRange
(
Colonne).NumberFormat
=
"0;"""";"""";"""
&
Libellé &
""""
Else
TS.ListObject.HeaderRowRange
(
Colonne).NumberFormat
=
"@"
End
If
TS_ChangerLibellé =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ChangerLibellé"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ChangerLibellé"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-H. TS_EffacerUneLigne▲
La fonction TS_EffacerUneLigne efface le contenu d’une ligne dans un tableau structuré, mais ne supprime pas la ligne.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Ligne : le numéro de la ligne concernée. Si ce nombre est zéro, alors la dernière ligne du tableau structuré est effacée.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour effacer la dernière ligne du tableau structuré nommé « TS_Eleves » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_EffacerUneLigne
(
TS:=
Tableau, Ligne:=
0
)
End
Sub
'------------------------------------------------------------------------------------------------
Ou :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Call
TS_EffacerUneLigne
(
Range
(
"TS_Eleves"
), 0
)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_EffacerUneLigne
(
TS As
Range, ByVal
Ligne As
Long
) As
Boolean
'------------------------------------------------------------------------------------------------
' Efface le contenu d'une ligne dans un Tableau Structuré, mais ne la supprime pas, même si elle est masquée.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Ligne : la position de la ligne à effacer dans le tableau.
' Si 0 alors efface la dernière ligne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si l'effacement a été réalisé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Contrôle la cohérence de la ligne passée en argument:
Ligne =
TS_IndexLigne
(
TS, Ligne)
If
Ligne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Efface la ligne:
Select
Case
TS.ListObject.ListRows.Count
Case
Is
>
1
TS.ListObject.DataBodyRange.Rows
(
Ligne).Clear
Case
1
Dim
i As
Long
For
i =
1
To
TS.ListObject.ListColumns.Count
TS.ListObject.DataBodyRange
(
1
, i).Clear
Next
i
End
Select
TS_EffacerUneLigne =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_EffacerUneLigne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_EffacerUneLigne"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-I. TS_EffacerToutesLignes▲
La fonction TS_EffacerToutesLignes efface le contenu d’un tableau structuré, mais ne le supprime pas.
Son argument est :
- TS : la plage (de type Range) qui représente le tableau structuré.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour effacer le contenu du tableau structuré nommé « TS_Eleves » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_EffacerToutesLignes
(
Tableau)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_EffacerToutesLignes
(
TS As
Range) As
Boolean
'------------------------------------------------------------------------------------------------
' Efface le contenu de toutes les lignes dans un Tableau Structuré, mais ne les supprime pas,
' même si elles sont masquées.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Efface toutes les lignes du tableau:
Select
Case
TS.ListObject.ListRows.Count
Case
Is
>
1
TS.ListObject.DataBodyRange.Clear
Case
1
Dim
i As
Long
For
i =
1
To
TS.ListObject.ListColumns.Count
TS.ListObject.DataBodyRange
(
1
, i).Clear
Next
i
End
Select
TS_EffacerToutesLignes =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_EffacerToutesLignes"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_EffacerToutesLignes"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-J. TS_AjouterUneLigne▲
La fonction TS_AjouterUneLigne ajoute une ligne dans un tableau structuré.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Ligne : (facultatif) la position où ajouter une ligne. Si ce nombre est zéro (valeur par défaut), alors une ligne est ajoutée à la suite du tableau structuré.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour ajouter une ligne en deuxième position puis à la fin du tableau structuré nommé « TS_Eleves » :
‘------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
‘------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_AjouterUneLigne
(
TS:=
Tableau, Ligne:=
2
)
Call
TS_AjouterUneLigne
(
TS:=
Tableau, Ligne:=
0
)
End
Sub
‘------------------------------------------------------------------------------------------------
Remarque : avant d’ajouter une ligne au tableau, il convient de mémoriser les éventuels filtres existants et de les supprimer, puis de les restaurer à la fin du traitement. Nous verrons cela en détail dans un autre chapitre.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_AjouterUneLigne
(
TS As
Range, Optional
ByVal
Ligne As
Long
=
0
) As
Boolean
'------------------------------------------------------------------------------------------------
' Ajoute une ligne dans un Tableau Structuré (même si elle est masquée).
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Ligne : la position où ajouter la ligne dans le tableau.
' Si 0 alors ajoute la ligne à la suite du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une ligne a été ajoutée.
'------------------------------------------------------------------------------------------------
Dim
MesFiltres As
Variant
Dim
Anc_ScreenUpdating As
Boolean
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' 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
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_AjouterUneLigne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_AjouterUneLigne"
End
If
Err
.Clear
End
Function
‘------------------------------------------------------------------------------------------------
II-K. TS_SupprimerUneLigne▲
La fonction TS_SupprimerUneLigne supprime une ligne dans un tableau structuré.
Une fois toutes les lignes supprimées, il ne reste qu’une ligne vide sous l’en-tête. En VBA, le tableau sera initialisé lors de l’ajout d’une première ligne, voir la fonction TS_AjouterUneLigne.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Ligne : le numéro de la ligne à supprimer. Si ce nombre est zéro, alors la dernière ligne du tableau structuré est supprimée.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour supprimer la dernière ligne du tableau structuré nommé « TS_Eleves » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_SupprimerUneLigne
(
Tableau, 0
)
End
Sub
'------------------------------------------------------------------------------------------------
Remarque : avant de supprimer une ligne au tableau, il convient de mémoriser les éventuels filtres existants et de les supprimer, puis de les restaurer à la fin du traitement. Nous verrons cela en détail dans un autre chapitre.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_SupprimerUneLigne
(
TS As
Range, ByVal
Ligne As
Long
) As
Boolean
'------------------------------------------------------------------------------------------------
' Supprime une ligne dans un Tableau Structuré, même si elle est masquée.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Ligne : la position de la ligne à supprimer dans le tableau.
' Si 0 alors supprime la dernière ligne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une ligne a été supprimée.
'------------------------------------------------------------------------------------------------
Dim
MesFiltres As
Variant
Dim
Anc_ScreenUpdating As
Boolean
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Contrôle la cohérence de la ligne passée en argument:
Ligne =
TS_IndexLigne
(
TS, Ligne)
If
Ligne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Bloque la mise à jour de l'écran:
Anc_ScreenUpdating =
Application.ScreenUpdating
Application.ScreenUpdating
=
False
' Mémorise les éventuels filtres et les retire:
Call
TS_Filtres_Mémoriser
(
TS, MesFiltres)
Call
TS_Filtres_Effacer
(
TS)
' Supprime la ligne:
TS.ListObject.ListRows
(
Ligne).Delete
TS_SupprimerUneLigne =
True
' Restaure les filtres et l'affichage:
Call
TS_Filtres_Restaurer
(
TS, MesFiltres)
Application.ScreenUpdating
=
Anc_ScreenUpdating
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_SupprimerUneLigne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_SupprimerUneLigne"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-L. TS_SupprimerPlusieursLignes▲
La fonction TS_SupprimerPlusieursLignes supprime plusieurs lignes consécutives dans un tableau structuré.
Une fois toutes les lignes supprimées il ne reste qu’une ligne vide sous l’en-tête. En VBA, le tableau sera initialisé lors de l’ajout d’une première ligne, voir la fonction TS_AjouterUneLigne.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- LigneDébut : le numéro de la première ligne à supprimer ;
- LigneFin : le numéro de la dernière ligne à supprimer (si ce nombre est zéro alors la dernière ligne du tableau structuré est supprimée).
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour supprimer de la huitième ligne jusqu'à la dernière ligne du tableau structuré nommé « TS_Eleves » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_SupprimerPlusieursLignes
(
Tableau, 8
, 0
)
End
Sub
'------------------------------------------------------------------------------------------------
Remarque : avant de supprimer les lignes au tableau, il convient de mémoriser les éventuels filtres existants et de les supprimer, puis de les restaurer à la fin du traitement. Nous verrons cela en détail dans un autre chapitre.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_SupprimerPlusieursLignes
(
TS As
Range, ByVal
LigneDébut As
Long
, ByVal
LigneFin As
Long
) As
Boolean
'------------------------------------------------------------------------------------------------
' Supprime plusieurs lignes dans un Tableau Structuré, même si elles sont masquées.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' LigneDébut : La position de la première ligne à supprimer dans le tableau.
' LigneFin : La position de la dernière ligne à supprimer dans le tableau
' Si 0 alors supprime la dernière ligne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si une ligne a été supprimée.
'------------------------------------------------------------------------------------------------
' Remarque : Une fois toutes les lignes supprimées, il ne reste qu'une ligne vide sous l'en-tête.
'------------------------------------------------------------------------------------------------
Dim
MesFiltres As
Variant
Dim
Anc_ScreenUpdating As
Boolean
Dim
Ligne As
Long
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Si la ligne de début est hors du tableau alors ne rien faire:
If
LigneDébut >
TS.ListObject.ListRows.Count
Then
TS_SupprimerPlusieursLignes =
True
GoTo
Gest_Err
End
If
' Contrôle la cohérence des lignes passées en argument:
LigneDébut =
TS_IndexLigne
(
TS, LigneDébut)
If
LigneDébut =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
LigneFin =
TS_IndexLigne
(
TS, LigneFin)
If
LigneFin =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' S'il faut inverser le début et la fin:
If
LigneFin <
LigneDébut Then
Ligne =
LigneDébut
LigneDébut =
LigneFin
LigneFin =
Ligne
End
If
' Bloque la mise à jour de l'écran:
Anc_ScreenUpdating =
Application.ScreenUpdating
Application.ScreenUpdating
=
False
' Mémorise les éventuels filtres et les retire:
Call
TS_Filtres_Mémoriser
(
TS, MesFiltres)
Call
TS_Filtres_Effacer
(
TS)
' Supprime les lignes:
TS.ListObject.DataBodyRange.Rows
(
LigneDébut &
":"
&
LigneFin).Delete
TS_SupprimerPlusieursLignes =
True
' Restaure les filtres et l'affichage:
Call
TS_Filtres_Restaurer
(
TS, MesFiltres)
Application.ScreenUpdating
=
Anc_ScreenUpdating
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_SupprimerPlusieursLignes"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_SupprimerPlusieursLignes"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-M. TS_SupprimerToutesLignes▲
La fonction TS_SupprimerToutesLignes supprime toutes les lignes dans un tableau structuré, mais ne le supprime pas (pour cela utilisez la fonction TS_SupprimerLeTableau), il ne reste qu'une ligne vide sous l'en-tête. En VBA, le tableau sera initialisé lors de l’ajout d’une première ligne, voir la fonction TS_AjouterUneLigne.
Son argument est :
- TS : la plage (de type Range) qui représente le tableau structuré.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour supprimer toutes les lignes du tableau structuré nommé « TS_Eleves » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_SupprimerToutesLignes
(
Tableau)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_SupprimerToutesLignes
(
TS As
Range) As
Boolean
'------------------------------------------------------------------------------------------------
' Supprime toutes les lignes d'un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Efface les éventuels filtres:
Call
TS_Filtres_Effacer
(
TS)
' Supprime toutes les lignes:
If
Not
TS.ListObject.DataBodyRange
Is
Nothing
Then
TS.ListObject.DataBodyRange.Delete
TS_SupprimerToutesLignes =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_SupprimerToutesLignes"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_SupprimerToutesLignes"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-N. TS_SupprimerLignesVisibles▲
La fonction TS_SupprimerLignesVisibles supprime les lignes visibles dans un tableau structuré, lignes préalablement sélectionnées par un filtre.
Si toutes les lignes sont supprimées il ne reste qu’une ligne vide sous l’en-tête. En VBA, le tableau sera initialisé lors de l’ajout d’une première ligne, voir la fonction TS_AjouterUneLigne.
Son argument est :
- TS : la plage (de type Range) qui représente le tableau structuré.
La fonction renvoie : le nombre de lignes supprimées ou -1 en car d'erreur.
'------------------------------------------------------------------------------------------------
Function
TS_SupprimerLignesVisibles
(
TS As
Range) As
Long
'------------------------------------------------------------------------------------------------
' Supprime les lignes visibles dans un tableau structuré, lignes normalement préalablement
' sélectionnées avec les filtres (si tout est affiché alors le tableau est vidé).
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : Le nombre de lignes supprimées ou -1 en cas d'erreur.
'------------------------------------------------------------------------------------------------
Dim
NbAvant As
Long
, AncDisplayAlerts As
Boolean
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Compte le nombre de ligne avant le traitement:
NbAvant =
TS_Nombre_Lignes
(
TS)
' Suppression des lignes visibles:
AncDisplayAlerts =
Application.DisplayAlerts
Application.DisplayAlerts
=
False
TS.ListObject.DataBodyRange.SpecialCells
(
xlCellTypeVisible).Delete
Application.DisplayAlerts
=
AncDisplayAlerts
' Renvoie le nombre de lignes supprimées:
TS_SupprimerLignesVisibles =
NbAvant -
TS_Nombre_Lignes
(
TS)
' Fin du traitement, renvoie -1 en cas d'erreur:
Gest_Err
:
If
Err
.Number
=
1004
Then
Err
.Clear
' Pas de donnée.
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
TS_SupprimerLignesVisibles =
-
1
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_SupprimerLignesVisibles"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_SupprimerLignesVisibles"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-O. TS_SupprimerLignesMasquées▲
La fonction TS_SupprimerLignesMasquées supprime les lignes masquées dans un tableau structuré suite à l'utilisation d'un filtre.
Son argument est :
- TS : la plage (de type Range) qui représente le tableau structuré.
La fonction renvoie : le nombre de lignes supprimées ou -1 en car d'erreur.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Function
TS_SupprimerLignesMasquées
(
TS As
Range) As
Long
'------------------------------------------------------------------------------------------------
' Supprime les lignes masquées dans un tableau structuré, lignes normalement préalablement
' masquées avec les filtres (une ligne filtrée ne peut pas être supprimée c'est pourquoi il faut
' ôter les filtres pour supprimer les lignes concernées puis restaurer les filtres).
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : Le nombre de lignes supprimées ou -1 en cas d'erreur.
'------------------------------------------------------------------------------------------------
Dim
NbAvant As
Long
, y As
Long
Dim
MesFiltres As
Variant
Dim
Anc_ScreenUpdating As
Boolean
Dim
Lignes
(
) As
Long
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Compte le nombre de ligne avant le traitement:
NbAvant =
TS_Nombre_Lignes
(
TS)
ReDim
Lignes
(
0
To
NbAvant)
' Mémorise les lignes masquées (càd hauteur = 0):
For
y =
1
To
TS_Nombre_Lignes
(
TS)
Lignes
(
y) =
TS.ListObject.DataBodyRange
(
y, 1
).Height
Next
y
' Bloque la mise à jour de l'écran:
Anc_ScreenUpdating =
Application.ScreenUpdating
Application.ScreenUpdating
=
False
' Mémorise les éventuels filtres et les retire:
Call
TS_Filtres_Mémoriser
(
TS, MesFiltres)
Call
TS_Filtres_Effacer
(
TS)
' Supprime les lignes qui étaient masquées:
For
y =
TS_Nombre_Lignes
(
TS) To
1
Step
-
1
If
Lignes
(
y) =
0
Then
TS.ListObject.ListRows
(
y).Delete
Next
y
' Restaure les filtres et l'affichage:
Call
TS_Filtres_Restaurer
(
TS, MesFiltres)
Application.ScreenUpdating
=
Anc_ScreenUpdating
' Renvoie le nombre de lignes supprimées:
TS_SupprimerLignesMasquées =
NbAvant -
TS_Nombre_Lignes
(
TS)
' Fin du traitement, renvoie -1 en cas d'erreur:
Gest_Err
:
If
Err
.Number
=
1004
Then
Err
.Clear
' Pas de donnée.
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
TS_SupprimerLignesMasquées =
-
1
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_SupprimerLignesMasquées"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_SupprimerLignesMasquées"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-P. TS_SupprimerDoublons▲
La fonction TS_SupprimerDoublons supprime les doublons dans un tableau structuré. Les lignes masquées par un filtre sont quand même prises en compte
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- ListeColonnes : la ou les colonnes concernées (dans ce cas passez un Array).
La fonction renvoie : le nombre de lignes supprimées ou -1 en car d'erreur.
Exemples d'appels sur le tableau « TS_Eleves » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
TS As
Range
Set
TS =
Range
(
"TS_Eleves"
)
Call
TS_SupprimerDoublons
(
TS, "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
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------
Function
TS_SupprimerDoublons
(
TS As
Range, ListeColonnes As
Variant
) As
Long
'------------------------------------------------------------------------------------------------
' Supprime les doublons dans un tableau structuré sur une ou plusieurs colonnes de critères,
' les lignes filtrées masquées sont quand même prises en compte.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' ListeColonnes : La ou les colonnes concernées (dans ce cas passez un Array).
'------------------------------------------------------------------------------------------------
' Renvoie : Le nombre de lignes supprimées ou -1 en cas d'erreur.
'------------------------------------------------------------------------------------------------
Dim
NbAvant As
Long
Dim
Colonnes As
String
, i As
Integer
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Compte le nombre de ligne avant le traitement:
NbAvant =
TS_Nombre_Lignes
(
TS)
' Récupère le numéro des colonnes:
If
IsArray
(
ListeColonnes) =
True
Then
Colonnes =
TS_IndexColonne
(
TS, ListeColonnes
(
0
))
For
i =
1
To
UBound
(
ListeColonnes)
Colonnes =
Colonnes &
","
&
TS_IndexColonne
(
TS, ListeColonnes
(
i))
Next
i
Else
Colonnes =
TS_IndexColonne
(
TS, ListeColonnes)
End
If
' Suppression des doublons:
TS.ListObject.Range.RemoveDuplicates
Columns:=
Array
(
Colonnes), Header:=
xlYes
' Renvoie le nombre de lignes supprimées:
TS_SupprimerDoublons =
NbAvant -
TS_Nombre_Lignes
(
TS)
' Fin du traitement, renvoie -1 en cas d'erreur:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
TS_SupprimerDoublons =
-
1
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_SupprimerDoublons"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_SupprimerDoublons"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-Q. TS_AjouterUneColonne▲
La fonction TS_AjouterUneColonne ajoute une colonne dans un tableau structuré.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le numéro de la colonne ou le nom de la colonne après lequel insérer une nouvelle colonne. Si vide ou 0, alors ajoute une colonne à la fin du tableau structuré ;
- Nom : le nom de la nouvelle colonne. Si vide, alors Excel attribuera un nom d'office et « Nom » sera renseigné.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour ajouter une colonne nommée « Note2 » à la fin du tableau structuré nommé « TS_Eleves », puis lui changer son libellé en « 2e Note » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_AjouterUneColonne
(
TS:=
Tableau, Colonne:=
0
, Nom:=
"Note2"
)
Call
TS_ChangerLibellé
(
TS:=
Tableau, Colonne:=
0
, Libellé:=
"2ème"
&
vbCrLf
&
"Note"
)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_AjouterUneColonne
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
Nom As
String
) As
Boolean
'------------------------------------------------------------------------------------------------
' Ajoute une colonne dans un tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne où insérer une nouvelle colonne.
' Si vide ou 0 alors ajoute une colonne à la fin du tableau.
' Nom = Le nom de la nouvelle colonne.
' Si vide alors Excel attribuera un nom d'office et Nom sera alimenté.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une colonne a été ajoutée.
'------------------------------------------------------------------------------------------------
Dim
i As
Integer
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
TS.ListObject.ShowHeaders
=
True
' Si le nom existe déjà alors il n'est pas possible de créer la nouvelle colonne:
For
i =
1
To
TS.ListObject.ListColumns.Count
If
TS.ListObject.ListColumns
(
i).Name
=
Nom Then
_
Err
.Raise
vbObjectError
, , "La colonne ["
&
Nom &
"] existe déjà dans le tableau."
Next
i
' S'il faut traiter la dernière colonne:
If
Colonne =
""
Then
Colonne =
0
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
If
Colonne <>
0
Then
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
End
If
Select
Case
Colonne
Case
0
' Ajoute une colonne à la suite du tableau:
TS.ListObject.ListColumns.Add.Name
=
Nom
Nom =
TS.ListObject.ListColumns
(
TS.ListObject.ListColumns.Count
).Name
TS.ListObject.HeaderRowRange
(
TS.ListObject.ListColumns.Count
).NumberFormat
=
"@"
TS_AjouterUneColonne =
True
Case
Else
' Ajoute une colonne dans le tableau:
TS.ListObject.ListColumns.Add
(
Colonne).Name
=
Nom
Nom =
TS.ListObject.ListColumns
(
Colonne).Name
TS.ListObject.HeaderRowRange
(
Colonne).NumberFormat
=
"@"
TS_AjouterUneColonne =
True
End
Select
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_AjouterUneColonne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_AjouterUneColonne"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-R. TS_SupprimerUneColonne▲
La fonction TS_SupprimerUneColonne supprime une colonne dans un tableau structuré.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le numéro de la colonne ou le nom de la colonne à supprimer. Si vide ou 0, alors supprime la dernière colonne du tableau structuré.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Remarque : supprimer toutes les colonnes d’un tableau structuré équivaut à le supprimer, voir la fonction TS_SupprimerLeTableau.
Exemple pour supprimer la colonne « Note2 » du tableau structuré nommé « TS_Eleves » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_SupprimerUneColonne
(
TS:=
Tableau, Colonne:=
"Note2"
)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_SupprimerUneColonne
(
TS As
Range, ByVal
Colonne As
Variant
) As
Boolean
'------------------------------------------------------------------------------------------------
' Supprime une colonne dans un tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne à supprimer.
' Si vide ou 0 alors supprime la dernière colonne du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une colonne a été supprimée.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Supprime une colonne dans le tableau:
TS.ListObject.ListColumns
(
Colonne).Delete
TS_SupprimerUneColonne =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
Err
.Number
, "TS_SupprimerUneColonne"
, Err
.Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
Err
.Number
&
" : "
&
Err
.Description
, vbInformation
, "TS_SupprimerUneColonne"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-S. TS_DéplacerUneColonne▲
La fonction TS_DéplacerUneColonne déplace une colonne dans un tableau structuré.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne_Source : le numéro de la colonne ou le nom de la colonne à déplacer. Si vide ou 0, alors déplace la dernière colonne ;
- Colonne_Dest : le numéro de la colonne destination où déplacer les données. Si vide ou 0, alors déplace les données la dernière colonne.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour s'assurer que les colonnes du tableau structuré « TS_Eleves » sont bien dans l'ordre désiré. Les colonnes sont déplacées en cas de besoin :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
i As
Integer
Dim
Ordre As
Variant
' Définition des colonnes que l'on souhaite déplacer
Ordre =
Array
(
"Nom"
, "Prénom"
, "Note"
, "Date"
, "Prochain"
)
' Boucle sur les colonnes pour les déplacer dans cet ordre.
' Attention le tableau est en base 0 (de 0 à n-1) alors que les colonnes
' d'un tableau structuré vont de 1 à n et pas de 0 à n-1:
For
i =
LBound
(
Ordre) To
UBound
(
Ordre)
Call
TS_DéplacerUneColonne
(
TS:=
Range
(
"TS_Eleves"
), Colonne_Source:=
Ordre
(
i), Colonne_Dest:=
i +
1
)
Next
i
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_DéplacerUneColonne
(
TS As
Range, _
ByVal
Colonne_Source As
Variant
, _
ByVal
Colonne_Dest As
Variant
) As
Boolean
'------------------------------------------------------------------------------------------------
' Déplace une colonne dans un tableau structuré.
'------------------------------------------------------------------------------------------------------
' TS : le tableau structuré.
' Colonne_Source : la colonne à déplacer (son nom ou son numéro).
' Si 0 alors déplace la dernière colonne.
' Colonne_Dest : la colonne destination où déplacer les données (son nom ou son numéro).
' Si 0 alors déplace les données à la dernière colonne.
'------------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim
Nom As
String
, NomCréé As
String
Dim
MesFiltres As
Variant
Dim
Anc_ScreenUpdating As
Boolean
Dim
Anc_Cursor As
Long
Dim
Titres
(
) As
Variant
Dim
i As
Integer
, id As
Integer
, y As
Long
Dim
Copie As
Variant
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Bloque les mises à jour de l'écran:
Anc_Cursor =
Application.Cursor
Application.Cursor
=
xlDefault
Anc_ScreenUpdating =
Application.ScreenUpdating
Application.ScreenUpdating
=
False
' Mémorise les titres (libellé et largeur):
ReDim
Titre
(
1
To
TS.ListObject.ListColumns.Count
, 1
To
3
)
For
i =
1
To
TS.ListObject.ListColumns.Count
Titre
(
i, 1
) =
TS.ListObject.HeaderRowRange
(
i).Formula
Titre
(
i, 2
) =
TS.ListObject.ListColumns
(
i).Range.ColumnWidth
Titre
(
i, 3
) =
TS.ListObject.HeaderRowRange
(
i).NumberFormat
Next
i
' Retrouve le numéro de la colonne source et vérifie sa cohérence (ou -1 si erreur):
Colonne_Source =
TS_IndexColonne
(
TS, Colonne_Source)
If
Colonne_Source =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Retrouve le numéro de la colonne destination et vérifie sa cohérence (ou -1 si erreur):
Colonne_Dest =
TS_IndexColonne
(
TS, Colonne_Dest)
If
Colonne_Dest =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' S'il faut déplacer la colonne:
If
Colonne_Source <>
Colonne_Dest Then
' Mémorise les éventuels filtres et les retire:
Call
TS_Filtres_Mémoriser
(
TS, MesFiltres)
Call
TS_Filtres_Effacer
(
TS)
' Mémorise le nom de la colonne source:
Nom =
TS.ListObject.ListColumns
(
Colonne_Source).Name
' Mémorise toutes les formules:
Copie =
TS.ListObject.DataBodyRange.Formula
' Corrige le numéro de la colonne destination si ajout:
If
Colonne_Source <
Colonne_Dest Then
Colonne_Dest =
Colonne_Dest +
1
' Ajoute une colonne et mémorise le nom attribué par Excel:
TS.ListObject.ListColumns.Add
Position:=
Colonne_Dest
NomCréé =
TS.ListObject.ListColumns
(
Colonne_Dest).Name
' Retrouve la position de la colonne source:
Colonne_Source =
TS.ListObject.ListColumns
(
Nom).Index
' Copie la source dans la destination puis supprime la source:
TS.ListObject.ListColumns
(
Colonne_Source).DataBodyRange.Cut
TS.ListObject.ListColumns
(
Colonne_Dest).DataBodyRange
TS.ListObject.ListColumns
(
Colonne_Source).Delete
' Retrouve la position de la colonne destination pour lui affecté le nom d'origine:
Colonne_Dest =
TS.ListObject.ListColumns
(
NomCréé).Index
TS.ListObject.ListColumns
(
Colonne_Dest).Name
=
Nom
' Ainsi que ses formules:
TS.ListObject.ListColumns
(
Colonne_Dest).DataBodyRange.Formula
=
Copie
' Restaure les filtres et l'affichage:
Call
TS_Filtres_Restaurer
(
TS, MesFiltres)
' Restaure les titres:
For
i =
1
To
TS.ListObject.ListColumns.Count
id =
TS.ListObject.ListColumns
(
Titre
(
i, 1
)).Index
TS.ListObject.ListColumns
(
id).Range.ColumnWidth
=
Titre
(
i, 2
)
TS.ListObject.HeaderRowRange
(
id).NumberFormat
=
Titre
(
i, 3
)
' Restaure les formules:
For
y =
1
To
TS.ListObject.ListRows.Count
TS.ListObject.Range
(
y +
1
, id) =
Copie
(
y, i)
Next
y
Next
i
End
If
' Fin du traitement:
Gest_Err
:
Application.Cursor
=
Anc_Cursor
Application.ScreenUpdating
=
Anc_ScreenUpdating
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_DéplacerUneColonne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_DéplacerUneColonne"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-T. TS_AfficherOuMasquerColonne▲
La fonction TS_AfficherOuMasquerColonne permet d'afficher ou de masquer une colonne dans un tableau structuré.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le numéro ou le nom de la colonne concernée. Si vide ou 0, alors prend la dernière colonne du tableau structuré ;
- EstVisible : Si
True
alors la colonne est visible, siFalse
alors elle est masquée.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_AfficherOuMasquerColonne
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
EstVisible As
Boolean
) As
Boolean
'------------------------------------------------------------------------------------------------
' Affiche ou masque une colonne d'un tableau structuré situé dans ce classeur.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' EstVisible : Si VRAI alors la colonne est visible, si FAUX alors elle est masquée.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Retrouve la colonne sur la feuille:
Colonne =
Colonne +
TS.Column
-
1
' Affiche ou Masque:
Sheets
(
TS.Parent.Name
).Columns
(
Colonne).EntireColumn.Hidden
=
Not
EstVisible
' Renvoie VRAI:
TS_AfficherOuMasquerColonne =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_AfficherOuMasquerColonne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_AfficherOuMasquerColonne"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-U. TS_LargeurColonne▲
La fonction TS_LargeurColonne définit la largeur (en points) d'une colonne d'un tableau structuré situé dans le classeur.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le numéro ou le nom de la colonne concernée. Si vide ou 0, alors prend la dernière colonne du tableau structuré ;
- Largeur : la largeur de la colonne ou 0 pour un ajustement automatique.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_LargeurColonne
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
ByVal
Largeur As
Double
) As
Boolean
'------------------------------------------------------------------------------------------------
' Définit la largeur (en points) d'une colonne d'un tableau structuré situé dans ce classeur.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Largeur : La largeur de la colonne ou 0 pour un ajustement automatique.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Retrouve la colonne sur la feuille:
Colonne =
Colonne +
TS.Column
-
1
' Définit la largeur:
Select
Case
Largeur
Case
0
: Sheets
(
TS.Parent.Name
).Columns
(
Colonne).EntireColumn.AutoFit
Case
Else
: Sheets
(
TS.Parent.Name
).Columns
(
Colonne).ColumnWidth
=
Largeur
End
Select
' Renvoie VRAI:
TS_LargeurColonne =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_LargeurColonne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_LargeurColonne"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-V. TS_OptionsStyle▲
La fonction TS_OptionsStyle définit les options de style du tableau structuré à afficher ou masquer.
Soit l’équivalant de l’onglet « Création » du ruban lorsque le tableau est sélectionné :
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Bouton_Filtre : (facultatif)
True
pour activer l’option,False
pour désactiver l’option ; - Ligne_Entête : (facultatif)
True
pour activer l’option,False
pour désactiver l’option ; - Ligne_Totaux : (facultatif)
True
pour activer l’option,False
pour désactiver l’option ; - Ligne_Bandes : (facultatif)
True
pour activer l’option,False
pour désactiver l’option ; - Colonne_Bandes : (facultatif)
True
pour activer l’option,False
pour désactiver l’option ; - Première_Colonne : (facultatif)
True
pour activer l’option,False
pour désactiver l’option ; - Dernière_Colonne : (facultatif)
True
pour activer l’option,False
pour désactiver l’option ; - StyleTableau : (facultatif) le nom du style du tableau structuré. Si l’argument est vide, alors le tableau sera sans style, s’il n’est pas renseigné le style ne sera pas modifié.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour masquer le bouton de filtre du tableau structuré nommé « TS_Eleves », afficher la ligne des totaux et le passer en style « moyen 6 » sans modifier les autres options :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_OptionsStyle
(
TS:=
Tableau, Bouton_Filtre:=
False
, Ligne_Totaux:=
True
, StyleTableau:=
"TableStyleMedium6"
)
End
Sub
'------------------------------------------------------------------------------------------------
Ou sans nommer les arguments (instruction plus courte, mais moins intuitive à relire) :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_OptionsStyle
(
Tableau, False
, , True
, , , , , "TableStyleMedium6"
)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_OptionsStyle
(
TS As
Range, _
Optional
Bouton_Filtre As
Integer
=
1
, _
Optional
Ligne_Entête As
Integer
=
1
, _
Optional
Ligne_Totaux As
Integer
=
1
, _
Optional
Ligne_Bandes As
Integer
=
1
, _
Optional
Colonne_Bandes As
Integer
=
1
, _
Optional
Première_Colonne As
Integer
=
1
, _
Optional
Dernière_Colonne As
Integer
=
1
, _
Optional
StyleTableau As
String
=
"/"
) As
Boolean
'------------------------------------------------------------------------------------------------
' Paramétrage des options de style du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : Le Tableau Structuré.
' Options : Si ignorée = l'option est laissée dans son état.
' Si True = l'option est passée à True.
' Si False = l'option est passée à False.
' StyleTableau : "" pour effacer ou le nom existant.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
Select
Case
Ligne_Entête
Case
True
: TS.ListObject.ShowHeaders
=
True
Case
False
: TS.ListObject.ShowHeaders
=
False
TS.ListObject.ShowAutoFilterDropDown
=
False
End
Select
Select
Case
Ligne_Totaux
Case
True
: TS.ListObject.ShowTotals
=
True
Case
False
: TS.ListObject.ShowTotals
=
False
End
Select
Select
Case
Ligne_Bandes
Case
True
: TS.ListObject.ShowTableStyleRowStripes
=
True
Case
False
: TS.ListObject.ShowTableStyleRowStripes
=
False
End
Select
Select
Case
Première_Colonne
Case
True
: TS.ListObject.ShowTableStyleFirstColumn
=
True
Case
False
: TS.ListObject.ShowTableStyleFirstColumn
=
False
End
Select
Select
Case
Dernière_Colonne
Case
True
: TS.ListObject.ShowTableStyleLastColumn
=
True
Case
False
: TS.ListObject.ShowTableStyleLastColumn
=
False
End
Select
Select
Case
Colonne_Bandes
Case
True
: TS.ListObject.ShowTableStyleColumnStripes
=
True
Case
False
: TS.ListObject.ShowTableStyleColumnStripes
=
False
End
Select
On
Error
GoTo
Poser_Filtre
Select
Case
Bouton_Filtre
Case
True
: TS.ListObject.ShowHeaders
=
True
TS.ListObject.ShowAutoFilterDropDown
=
True
Case
False
: TS.ListObject.ShowAutoFilterDropDown
=
False
End
Select
On
Error
GoTo
0
If
StyleTableau <>
"/"
Then
Sheets
(
TS.Parent.Name
).ListObjects
(
TS.ListObject.DisplayName
).TableStyle
=
StyleTableau
End
If
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
=
0
Then
TS_OptionsStyle =
True
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_OptionsStyle"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_OptionsStyle"
End
If
Err
.Clear
Exit
Function
Poser_Filtre
:
TS.ListObject.Range.AutoFilter
Resume
Next
End
Function
'------------------------------------------------------------------------------------------------
II-W. TS_DéfinirTotaux▲
La fonction TS_DéfinirTotaux définit le calcul pour la ligne des totaux d'une colonne d’un tableau structuré.
Si l’option d’affichage de la ligne des totaux n’était pas active, elle l’est automatiquement par l’appel à cette fonction.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée ;
- TypeCalcul : une valeur de l’énumération XlTotalsCalculation
- xlTotalsCalculationAverage : moyenne,
- xlTotalsCalculationCount : décompte des cellules non vides,
- xlTotalsCalculationCountNums : décompte des cellules contenant des valeurs numériques,
- xlTotalsCalculationMax : valeur maximale dans la liste,
- xlTotalsCalculationMin : valeur minimale dans la liste,
- xlTotalsCalculationNone : aucun calcul,
- xlTotalsCalculationStdDev : valeur écart-type,
- xlTotalsCalculationSum : somme de toutes les valeurs de la colonne de liste.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour compter le nombre d’élèves et la note moyenne :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_DéfinirTotaux
(
Tableau, "Nom"
, xlTotalsCalculationCount)
Call
TS_DéfinirTotaux
(
Tableau, "Note"
, xlTotalsCalculationAverage)
End
Sub
'------------------------------------------------------------------------------------------------
Remarque : nous étudierons dans un autre chapitre la mise en forme des cellules.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_DéfinirTotaux
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
TypeCalcul As
XlTotalsCalculation) As
Boolean
'------------------------------------------------------------------------------------------------
' Définit le type de calcul pour la ligne des totaux d'une colonne.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' TypeCalcul : Type de calcul à appliquer suivant l'énumération.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Affiche les totaux et pose le calcul:
TS.ListObject.ShowTotals
=
True
TS.ListObject.ListColumns
(
Colonne).TotalsCalculation
=
TypeCalcul
TS_DéfinirTotaux =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_DéfinirTotaux"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_DéfinirTotaux"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-X. TS_FormatColonne▲
La fonction TS_FormatColonne définit le format numérique des cellules d'une colonne dans un tableau structuré. Les cellules masquées sont également affectées.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le numéro de la colonne ou le nom de la colonne concernée, ou 0 pour traiter la dernière colonne ;
- FormatColonne : le format numérique à appliquer ;
- ForcerNumérique : (facultatif) si
True
alors remplace la virgule "," par un point "." pour qu'Excel reconnaisse les nombres comme des numériques et puisse les traiter correctement.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour mettre la dernière colonne en format date (jour/mois/année) du tableau structuré nommé « TS_Eleves » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Call
TS_FormatColonne
(
Range
(
"TS_Eleves"
), 0
, "dd/mm/yyyy"
)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_FormatColonne
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
FormatColonne As
String
, _
Optional
ForcerNumérique As
Boolean
=
False
) As
Boolean
'------------------------------------------------------------------------------------------------
' Définit le format d'une colonne (valable aussi sur les lignes masquées).
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' FormatColonne : Le format à appliquer à la colonne.
' ForcerNumérique : Si VRAI alors remplace la virgule "," par un point "." pour qu'Excel reconnaisse
' le nombre comme des numériques et puisse les traiter correctement.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Exemples avec un tableau structuré nommé "Tableau1":
' Pour mettre la dernière colonne en date : Call TS_FormatColonne(Range("Tableau1"), 0, "dd/mm/yyyy")
' Et pour la mettre en numérique sans virgule : Call TS_FormatColonne(Range("Tableau1"), 0, "0.0", True)
'------------------------------------------------------------------------------------------------
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' S'il faut remplacer la virgule par un point pour forcer le mode numérique d'Excel:
If
ForcerNumérique =
True
Then
Call
TS_Remplacer
(
TS, Colonne, ","
, "."
, False
, xlPart)
' Pose le format:
TS.ListObject.ListColumns
(
Colonne).DataBodyRange.NumberFormat
=
FormatColonne
' Renvoie VRAI:
TS_FormatColonne =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_FormatColonne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_FormatColonne"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
II-Y. TS_Aligner▲
La fonction TS_Aligner définit l'alignement vertical et/ou horizontal des données et/ou de l'en-tête et/ou du total d'une colonne dans un tableau structuré.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le numéro de la colonne ou le nom de la colonne concernée, ou 0 pour traiter la dernière colonne ;
- AlignementHorizontal : (facultatif) définit l'alignement horizontal suivant l’énumération XlHAlign
- -1 : (par défaut) ne modifie pas l'alignement,
- xlHAlignCenter = Centrer,
- xlHAlignCenterAcrossSelection = Centrer dans la sélection,
- xlHAlignDistributed = Distribuer,
- xlHAlignFill = Remplir,
- xlHAlignGeneral = Aligner en fonction du type de données,
- xlHAlignJustify = Justifier,
- xlHAlignLeft = Gauche,
- xlHAlignRight = Droite ; - AlignementVertical : (facultatif) définit l'alignement vertical suivant l’énumération XlVAlign
- -1 : (par défaut) ne modifie pas l'alignement,
- xlVAlignBottom = Inférieure,
- xlVAlignCenter = Centre,
- xlVAlignDistributed = Distribué,
- xlVAlignJustify = Justifier,
- xlVAlignTop = Haut ; - Aligner : (facultatif) définit quelles sont les cellules qui doivent être alignées suivant l’énumération personnelle Enum_TS_Aligner
- TS_Aligner_Données = (par défaut) les données,
- TS_Aligner_Entete = l'en-tête,
- TS_Aligner_Total = la ligne du total.
Vous pouvez cumuler ces valeurs : TS_Aligner_Données + TS_Aligner_Entete + TS_Aligner_Total.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour centrer l'en-tête et le total et aligner à gauche les données de la dernière colonne :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Call
TS_Aligner
(
Range
(
"TS_Liste_Noms"
),0
,xlHAlignCenter, ,TS_Aligner_Total+
TS_Aligner_Entete)
Call
TS_Aligner
(
range
(
"TS_Liste_Noms"
),0
,xlHAlignLeft)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_Aligner
(
TS As
Range, ByVal
Colonne As
Variant
, _
Optional
AlignementHorizontal As
XlHAlign =
-
1
, _
Optional
AlignementVertical As
XlVAlign =
-
1
, _
Optional
Aligner As
Enum_TS_Aligner =
TS_Aligner_Données) As
Boolean
'------------------------------------------------------------------------------------------------
' Définit l'alignement vertical et/ou horizontal des données et/ou de l'en-tête et/ou du total
' d'une colonne dans un tableau structuré.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' AlignementHorizontal : (facultatif) Définit l'alignement horizontal suivant l'énumération XlHAlign:
' -1 = Ne modifie pas l'alignement (valeur par défaut).
' xlHAlignCenter = Centrer.
' xlHAlignCenterAcrossSelection = Centrer dans la sélection.
' xlHAlignDistributed = Distribuer.
' xlHAlignFill = Remplir.
' xlHAlignGeneral = Aligner en fonction du type de données.
' xlHAlignJustify = Justifier.
' xlHAlignLeft = Gauche.
' xlHAlignRight = Droite.
' AlignementVertical : (facultatif) Définit l'alignement vertical suivant l'énumération XlVAlign:
' -1 = Ne modifie pas l'alignement (valeur par défaut).
' xlVAlignBottom = Inférieure
' xlVAlignCenter = Centre
' xlVAlignDistributed = Distribué
' xlVAlignJustify = Justifier
' xlVAlignTop = Haut
' Aligner : (facultatif) Définit quelles sont les cellules qui doivent être alignées.
' TS_Aligner_Données = Les données uniquement (valeur par défaut).
' TS_Aligner_Entete = L'en-tête uniquement.
' TS_Aligner_Total = La ligne du total.
' Vous pouvez cumuler ces valeurs : TS_Aligner_Données + TS_Aligner_Entete + TS_Aligner_Total
'------------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Remarque : Si l'en-tête et/ou le total doivent être alignés alors ils sont automatiquement affichés.
'------------------------------------------------------------------------------------------------------
' Exemple pour centrer l'en-tête et le total et aligner à gauche les données de la dernière colonne:
' Call TS_Aligner(Range("TS_Liste_Noms"),0,xlHAlignCenter, ,TS_Aligner_Total+TS_Aligner_Entete)
' Call TS_Aligner(range("TS_Liste_Noms"),0,xlHAlignLeft)
'------------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Alignement horizontal de la colonne:
If
AlignementHorizontal <>
-
1
Then
' Les données:
If
(
Aligner And
TS_Aligner_Données) >
0
Then
_
TS.ListObject.ListColumns
(
Colonne).DataBodyRange.HorizontalAlignment
=
AlignementHorizontal
' L'en-tête:
If
(
Aligner And
TS_Aligner_Entete) >
0
Then
_
TS.ListObject.ShowHeaders
=
True
: TS.ListObject.HeaderRowRange
(
Colonne).HorizontalAlignment
=
AlignementHorizontal
' Le total:
If
(
Aligner And
TS_Aligner_Total) >
0
Then
_
TS.ListObject.ShowTotals
=
True
: TS.ListObject.ListColumns
(
Colonne).Total.HorizontalAlignment
=
AlignementHorizontal
End
If
' Alignement vertical de la colonne:
If
AlignementVertical <>
-
1
Then
' Les données:
If
(
Aligner And
TS_Aligner_Données) >
0
Then
_
TS.ListObject.ListColumns
(
Colonne).DataBodyRange.VerticalAlignment
=
AlignementVertical
' L'en-tête:
If
(
Aligner And
TS_Aligner_Entete) Then
_
TS.ListObject.ShowHeaders
=
True
: TS.ListObject.HeaderRowRange
(
Colonne).VerticalAlignment
=
AlignementVertical
' Le total:
If
(
Aligner And
TS_Aligner_Total) >
0
Then
_
TS.ListObject.ShowTotals
=
True
: TS.ListObject.ListColumns
(
Colonne).Total.VerticalAlignment
=
AlignementVertical
End
If
' Renvoie VRAI:
TS_Aligner =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_Aligner"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_Aligner"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
III. Trier, filtrer les données d’un tableau structuré▲
Les différentes fonctions de ce chapitre permettent de trier et filtrer les données d’un tableau structuré.
III-A. TS_TrierUneColonne▲
La fonction TS_TrierUneColonne trie la colonne passée en argument, en tenant compte de la casse.
Les lignes masquées sont ignorées dans le tri.
Si l’option d’affichage de la ligne bouton de filtre n’était pas active elle le devient automatiquement par l’appel à cette fonction.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou zéro, alors la dernière colonne du tableau est traitée ;
- Méthode : (facultatif) le paramètre de tri des données de l’énumération XlSortOn
- xlSortOnValues : (par défaut) trie suivant les valeurs,
- xlSortOnCellColor : trie suivant la couleur des cellules,
- xlSortOnFontColor : trie suivant la couleur de police ; - Ordre : (facultatif) l’ordre de tri de l’énumération XlSortOrder
- xlAscending : (par défaut) ordre croissant,
- xlDescending : ordre décroissant ; - EffacerAncienTri : (facultatif) si
True
(par défaut) alors efface l'ancien tri, siFalse
alors ajoute le tri à celui existant.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour trier les élèves par nom et prénom, dans l’ordre croissant :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_TrierUneColonne
(
TS:=
Tableau, Colonne:=
"Nom"
, Méthode:=
xlSortOnValues, Ordre:=
xlAscending, _
EffacerAncienTri:=
True
)
Call
TS_TrierUneColonne
(
TS:=
Tableau, Colonne:=
"Prénom"
, Méthode:=
xlSortOnValues, Ordre:=
xlAscending, _
EffacerAncienTri:=
False
)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_TrierUneColonne
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
Optional
Méthode As
XlSortOn =
xlSortOnValues, _
Optional
Ordre As
XlSortOrder =
xlAscending, _
Optional
EffacerAncienTri As
Boolean
=
True
) As
Boolean
'------------------------------------------------------------------------------------------------
' Trie une colonne d'un Tableau Structuré. La casse est prise en compte.
' Attention, les lignes masquées sont ignorées dans le tri.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne à trier.
' Si 0 ou vide alors trie la dernière colonne du Tableau Structuré.
' Paramètre de tri des données:
' xlSortOnValues = les valeurs.
' xlSortOnCellColor = couleur de cellule.
' xlSortOnFontColor = couleur de police.
' Ordre du tri :
' xlAscending = Croissant.
' xlDescending = Décroissant.
' EffacerAncienTri : Si Vrai alors efface l'ancien tri, sinon ajoute le tri à celui existant.
'-----------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'----------------------------------------------------------------------------------------
' Exemple d'utilisation pour trier par ordre croissant un tableau par nom et prénom (en deux étapes):
' TS_TrierUneColonne(Range("TS_x"), "Nom")
' TS_TrierUneColonne(Range("TS_x"),"Prénom",,, False)
'----------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Retrouve le nom de la colonne:
Colonne =
TS.ListObject.ListColumns
(
Colonne).Name
' Force l'affichage de l'option Bouton de filtre:
TS.ListObject.ShowHeaders
=
True
On
Error
GoTo
Poser_Filtre
TS.ListObject.ShowAutoFilterDropDown
=
True
On
Error
GoTo
0
' S'il faut effacer tous les anciens tris ou juste
' le tri sur la colonne concerné pour pouvoir en mettre un nouveau:
If
EffacerAncienTri =
True
Then
Call
TS_EffacerTri
(
TS, ""
)
Else
Call
TS_EffacerTri
(
TS, Colonne)
End
If
' Pose le tri sur la colonne:
TS.ListObject.Sort.SortFields.Add
Range
(
TS.ListObject.DisplayName
&
"["
&
Colonne &
"]"
), Méthode, Ordre
TS.ListObject.Sort.Apply
TS_TrierUneColonne =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_TrierUneColonne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_TrierUneColonne"
End
If
Err
.Clear
Exit
Function
Poser_Filtre
:
TS.ListObject.Range.AutoFilter
Resume
Next
End
Function
'------------------------------------------------------------------------------------------------
III-B. TS_EffacerTri▲
La fonction TS_EffacerTri efface le tri de la colonne passée en argument ou de toutes les colonnes.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le nom ou le numéro de la colonne concernée. Si cet argument vaut zéro alors la dernière colonne du tableau est traitée. S’il est vide alors tous les tris sont effacés.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour effacer tous les tris du tableau des élèves :
‘------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
‘------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_EffacerTri
(
TS:=
Tableau, Colonne:=
""
)
End
Sub
‘------------------------------------------------------------------------------------------------
Remarque : le fait d’effacer les tris n’a pas d’incidence sur l’ordre d’affichage du tableau structuré.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_EffacerTri
(
TS As
Range, ByVal
Colonne As
Variant
) As
Boolean
'------------------------------------------------------------------------------------------------
' Efface le tri d'une colonne (ou de toutes les colonnes) d'un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne à effacer le tri.
' Si 0 alors efface le tri de la dernière colonne du Tableau Structuré.
' Si vide alors efface tous les tris.
'-----------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'----------------------------------------------------------------------------------------
Dim
i As
Integer
, x As
Integer
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' S'il faut effacer tous les tris:
If
Colonne =
""
Then
On
Error
Resume
Next
TS.ListObject.Sort.SortFields.Clear
Err
.Clear
Else
' S'il faut effacer le tri d'une colonne:
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Retrouve le nom de la colonne:
Colonne =
TS.ListObject.ListColumns
(
Colonne).Name
' boucle sur les tris existants:
For
i =
1
To
TS.ListObject.Sort.SortFields.Count
' Récupère le numéro de la colonne concernée:
x =
TS.ListObject.Sort.SortFields
(
i).Key.Column
-
TS.Column
+
1
' Si c'est la colonne à traiter alors supprime le tri:
If
UCase
(
TS.ListObject.ListColumns
(
x).Name
) =
UCase
(
Colonne) Then
TS.ListObject.Sort.SortFields
(
i).Delete
TS.ListObject.Sort.Apply
Exit
For
End
If
Next
i
End
If
' Renvoie Vrai:
TS_EffacerTri =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_EffacerTri"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_EffacerTri"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
III-C. TS_Filtres_Existe▲
La fonction TS_Filtres_Existe renseigne si le tableau structuré passé en argument est filtré ou non, ou si une colonne particulière du tableau est filtrée.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : (facultatif, vide par défaut) le nom ou le numéro de la colonne qu'il faut analyser. Si cet argument vaut zéro alors la dernière colonne du tableau est traitée. S’il est vide alors tout le tableau est analysé.
La fonction renvoie True
:
- si le tableau a au moins un filtre actif et que l'argument « Colonne » est vide,
- si la colonne indiquée est filtrée.
Ou False
dans le cas contraire.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_Filtres_Existe
(
TS As
Range, Optional
ByVal
Colonne As
Variant
) As
Boolean
'-----------------------------------------------------------------------------------------------
' Indique si un Tableau Structuré est filtré ou non, ou si une colonne est filtrée ou non.
'-----------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Une colonne spécifique ou vide s'il faut analyser tout le tableau.
'-----------------------------------------------------------------------------------------------
' Renvoie : Vrai si le tableau a au moins un filtre actif et que l'argument Colonne est vide.
' Vrai si la Colonne indiquée est filtrée.
' Faux dans les autres cas.
'-----------------------------------------------------------------------------------------------
Dim
f As
Integer
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Si une colonne particulière est à analyser:
If
IsMissing
(
Colonne) =
True
Then
Colonne =
""
If
Colonne <>
""
Then
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
End
If
' Boucle sur les filtres du tableau pour savoir s'ils sont actifs ou non:
With
TS.ListObject.AutoFilter.Filters
For
f =
1
To
.Count
If
.Item
(
f).On
Then
TS_Filtres_Existe =
True
Exit
For
End
If
Next
' S'il ne faut analyser qu'une seule colonne:
If
Val
(
Colonne) >
0
Then
TS_Filtres_Existe =
.Item
(
Colonne).On
End
With
' Fin du traitement:
Gest_Err
:
If
Err
.Number
=
91
Then
Err
.Clear
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_Filtres_Existe"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_Filtres_Existe"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
III-D. TS_Filtres_Poser▲
La fonction TS_Filtres_Poser pose un filtre sur une colonne du tableau structuré.
Le filtre peut contenir un ou deux critères.
Les critères ne sont pas sensibles à la casse.
Pour filtrer une date vous devrez convertir la date de référence au format "année/mois/jour". Et curieusement pour filtrer sur un même jour vous devrez utiliser deux opérateurs (inférieur ou égal et supérieur ou égal) car égal ne fonctionne pas. Voir l'exemple dans le code de la fonction.
Si l’option d’affichage de l’option bouton de filtre n’était pas active, elle le devient automatiquement par l’appel à cette fonction.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou zéro, alors la dernière colonne du tableau est traitée ;
- Critère1 : le premier critère, à laisser vide pour effacer le filtre ;
- Opérateur : (facultatif) l'opérateur logique s’il y a deux critères de l’énumération XlAutoFilterOperator(1)
- xlAnd : opérateur logique « Et »,
- XlOr : opérateur logique « Ou » ; - Critère2 : (facultatif) le second critère.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour filtrer dans le tableau des élèves les notes supérieures à 10, les noms commençant par les lettres « T » ou « C », les prénoms « Alex » ou « Sarah » ou « Toto » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_Filtres_Poser
(
Tableau, "Note"
, ">10"
)
Call
TS_Filtres_Poser
(
Tableau, "Nom"
, "=t*"
, xlOr, "=c*"
)
Call
TS_Filtres_Poser
(
Tableau, "Prénom"
, Array
(
"alex"
, "sarah"
, "toto"
))
End
Sub
'------------------------------------------------------------------------------------------------
Exemple pour supprimer tous ces filtres :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_Filtres_Poser
(
Tableau, "Nom"
, ""
)
Call
TS_Filtres_Poser
(
Tableau, "prénom"
, ""
)
Call
TS_Filtres_Poser
(
Tableau, "note"
, ""
)
End
Sub
'------------------------------------------------------------------------------------------------
Remarque : pour supprimer les filtres d’une colonne ou du tableau structuré, vous pouvez aussi utiliser la fonction TS_Filtres_Effacer, voir ci-après.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_Filtres_Poser
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
ByVal
Critère1 As
Variant
, _
Optional
Opérateur As
XlAutoFilterOperator, _
Optional
Critère2 As
String
=
""
) As
Boolean
'------------------------------------------------------------------------------------------------
' Pose un filtre sur une colonne d'un Tableau Structuré.
' Pour plus d'informations :
' https://docs.microsoft.com/fr-fr/office/vba/api/excel.range.autofilter
' https://excel.developpez.com/faq/?page=Filtre
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Critère1 : le premier critère. Laissez à vide pour effacer le filtre
' Opérateur : l'opérateur logique.
' Critère2 : le second critère.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Exemples:
' TS_Filtres_Poser(range("TS_Eleves"),"Note",">10") pour les notes supérieures à 10.
' TS_Filtres_Poser(range("TS_Eleves"),"Nom","=m*", xlor, "=l*") pour les noms qui commencent par m ou l.
' TS_Filtres_Poser(range("TS_Eleves"),"Nom",Array("marx", "toto", "tini")) pour sélectionner certaines valeurs.
' TS_Filtres_Poser(range("TS_Eleves"),"Nom","") pour effacer le filtre sur le champ "Nom".
' Curieusement pour une date (à mettre au format année/mois/jour) il faut utiliser deux opérateurs,
' même pour filtrer un seul jour:
' TS_Filtres_Poser(range("TS_Eleves"),"Quand", ">=" & Year(Date) & "/" & Month(Date) & "/" & Day(Date), _
' xlAnd, "<=" & Year(Date) & "/" & Month(Date) & "/" & Day(Date)
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Si c'est un Array qui est passé en Critère 1:
If
IsArray
(
Critère1) =
True
Then
TS.ListObject.Range.AutoFilter
field:=
Colonne, Criteria1:=
Array
(
Critère1), Operator:=
xlFilterValues
' Si les critères sont des chaînes de caractères:
Else
' S'il faut effacer un filtre:
If
Critère1 =
""
Then
Critère1 =
Null
' S'il n'y a qu'un seul critère:
If
Critère2 =
""
Then
TS.ListObject.Range.AutoFilter
field:=
Colonne, Criteria1:=
Critère1
' S'il y a deux critères:
Else
TS.ListObject.Range.AutoFilter
field:=
Colonne, Criteria1:=
Critère1, Operator:=
Opérateur, Criteria2:=
Critère2
End
If
End
If
TS_Filtres_Poser =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_Filtres_Poser"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_Filtres_Poser"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
III-E. TS_Filtres_Effacer▲
La fonction TS_Filtres_Effacer efface le filtre d’une colonne ou de toutes les colonnes d’un tableau structuré.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le nom ou le numéro de la colonne concernée. Si cet argument vaut zéro, alors la dernière colonne du tableau est traitée. S’il est non renseigné ou vide, alors tous les filtres sont effacés.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour effacer tous les filtres du tableau des élèves :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_Filtres_Effacer
(
Tableau)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_Filtres_Effacer
(
TS As
Range, Optional
Colonne As
Variant
) As
Boolean
'------------------------------------------------------------------------------------------------
' Efface le filtre d'une colonne ou de toutes les colonnes d'un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne à effacer le filtre.
' Si 0 alors efface le filtre de la dernière colonne du Tableau Structuré.
' Si vide ou non renseigné alors efface tous les filtres.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' S'il faut effacer tous les filtres:
If
IsMissing
(
Colonne) =
True
Then
Colonne =
""
If
Colonne =
""
Then
On
Error
Resume
Next
TS.ListObject.AutoFilter.ShowAllData
Err
.Clear
TS_Filtres_Effacer =
True
Else
' S'il faut effacer le filtre d'une colonne:
If
TS_Filtres_Poser
(
TS, Colonne, ""
) =
False
Then
Err
.Raise
TS_Err_Number, , TS_Err_Description
Else
TS_Filtres_Effacer =
True
End
If
End
If
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_Filtres_Effacer"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_Filtres_Effacer"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
III-F. TS_Filtres_Mémoriser▲
La fonction TS_Filtres_Mémoriser mémorise dans une variable les filtres d’un tableau structuré.
Ce traitement permettra de les restituer ultérieurement, voir la fonction TS_Filtres_Restaurer.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Mémoire : la mémoire à utiliser.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour mémoriser les filtres du tableau des élèves :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Dim
MesFiltres As
Variant
Call
TS_Filtres_Mémoriser
(
Tableau, MesFiltres)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_Filtres_Mémoriser
(
TS As
Range, Mémoire As
Variant
) As
Boolean
'-----------------------------------------------------------------------------------------------
' Mémorise les filtres d'un Tableau Structuré.
'-----------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Mémoire : la mémoire à utiliser.
'-----------------------------------------------------------------------------------------------
' Renvoie : vrai si le tableau a au moins un filtre actif.
'-----------------------------------------------------------------------------------------------
Dim
f As
Integer
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Boucle sur les filtres du tableau:
With
TS.ListObject.AutoFilter.Filters
ReDim
Mémoire
(
1
To
.Count
, 1
To
3
)
For
f =
1
To
.Count
With
.Item
(
f)
If
.On
Then
TS_Filtres_Mémoriser =
True
Mémoire
(
f, 1
) =
.Criteria1
If
.Operator
Then
Mémoire
(
f, 2
) =
.Operator
Mémoire
(
f, 3
) =
.Criteria2
End
If
End
If
End
With
Next
End
With
' Fin du traitement:
Gest_Err
:
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
III-G. TS_Filtres_Restaurer▲
La fonction TS_Filtres_Restaurer restaure les filtres préalablement mémorisés dans une variable par la fonction TS_Filtres_Mémoriser.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Mémoire : la mémoire à utiliser.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour mémoriser les filtres du tableau des élèves, les effacer pour poser un nouveau filtre sur les notes supérieures à 10, afficher le nombre de ces notes, puis restaurer l’ancienne situation :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range, MesFiltres As
Variant
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_Filtres_Mémoriser
(
Tableau, MesFiltres)
Call
TS_Filtres_Effacer
(
Tableau)
Call
TS_Filtres_Poser
(
Tableau, "Note"
, ">10"
)
Call
TS_DéfinirTotaux
(
Tableau, "note"
, xlTotalsCalculationCountNums)
MsgBox
"Nombre de notes > 10"
Call
TS_Filtres_Restaurer
(
Tableau, MesFiltres)
Call
TS_OptionsStyle
(
Tableau, Ligne_Totaux:=
False
)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_Filtres_Restaurer
(
TS As
Range, Mémoire As
Variant
) As
Boolean
'-----------------------------------------------------------------------------------------------
' Restaure les filtres d'un Tableau Structuré préalablement mémorisés avec TS_Filtres_Mémoriser.
'-----------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Mémoire : la mémoire à utiliser.
'-----------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'-----------------------------------------------------------------------------------------------
Dim
f As
Integer
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
For
f =
1
To
UBound
(
Mémoire, 1
)
If
Not
IsEmpty
(
Mémoire
(
f, 1
)) Then
If
Mémoire
(
f, 2
) Then
TS.ListObject.Range.AutoFilter
field:=
f, _
Criteria1:=
Mémoire
(
f, 1
), _
Operator:=
Mémoire
(
f, 2
), _
Criteria2:=
Mémoire
(
f, 3
)
Else
TS.ListObject.Range.AutoFilter
field:=
f, Criteria1:=
Mémoire
(
f, 1
)
End
If
End
If
Next
' Fin du traitement:
TS_Filtres_Restaurer =
True
Gest_Err
:
Err
.Clear
End
Function
'-----------------------------------------------------------------------------------------------
III-H. TS_CouleurLigneChangeValeur▲
La fonction TS_CouleurLigneChangeValeur alterne la couleur de fond des lignes visibles d'un tableau structuré à chaque changement de valeur dans la colonne de votre choix.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le nom ou le numéro de la colonne concernée. Si le numéro est zéro, alors la dernière colonne du tableau est traitée. Si ce nom est vide ou -1 (valeur par défaut), alors efface toutes les couleurs des lignes visibles ;
- CoulA : le numéro de la première couleur, ou -1 (valeur par défaut) pour ne pas appliquer de couleur ;
- CoulB : le numéro de la seconde couleur, ou -1 (valeur par défaut) pour ne pas appliquer de couleur.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour alterner la couleur des lignes d'un tableau à chaque changement de Note :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves_1"
)
Call
TS_CouleurLigneChangeValeur
(
TS:=
Tableau, Colonne:=
"Note"
, CoulA:=
14277081
, CoulB:=
14348258
)
End
Sub
'------------------------------------------------------------------------------------------------
Pour effacer les couleurs personnelles (sur les lignes visibles) et restaurer les couleurs par défaut du tableau structuré, ne renseignez pas l'argument "Colonne" de la fonction :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves_1"
)
Call
TS_CouleurLigneChangeValeur
(
TS:=
Tableau)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_CouleurLigneChangeValeur
(
TS As
Range, Optional
ByVal
Colonne As
Variant
=
-
1
, _
Optional
ByVal
CoulA As
Long
=
xlNone, _
Optional
ByVal
CoulB As
Long
=
xlNone) As
Boolean
'------------------------------------------------------------------------------------------------
' Alterne la couleur de fond des lignes d'un tableau structuré à chaque changement de valeur dans la
' colonne de votre choix. Ou supprime toutes les couleurs des lignes visibles.
' Le tableau doit avoir au moins deux lignes.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
' Si 0 alors prend la dernière colonne du Tableau Structuré.
' Si vide ou -1 (valeur par défaut) alors efface toutes les couleurs des lignes visibles.
' CoulA : La première couleur à appliquer (sans couleur par défaut).
' CoulB : La seconde couleur à appliquer (sans couleur par défaut).
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim
y As
Long
Dim
AncValeur As
Variant
Dim
Coul As
Long
Dim
Anc_ScreenUpdating As
Boolean
Dim
Anc_Cursor As
Long
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Bloque les mises à jour de l'écran:
Anc_Cursor =
Application.Cursor
Application.Cursor
=
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
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_CouleurLigneChangeValeur"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_CouleurLigneChangeValeur"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
IV. Obtenir des informations sur les données d’un tableau structuré▲
Les deux premières fonctions de ce chapitre permettent d’obtenir des informations sur les dimensions d’un tableau structuré. Les deux suivantes renvoient des informations sur ses données.
IV-A. TS_Nombre_Lignes▲
La fonction TS_Nombre_Lignes renvoie le nombre de lignes du tableau structuré passé en argument.
Son argument est :
- TS : la plage (de type Range) qui représente le tableau structuré.
La fonction renvoie : le nombre de lignes du tableau structuré, donc zéro s’il est vide.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_Nombre_Lignes
(
TS As
Range) As
Long
'------------------------------------------------------------------------------------------------
TS_Nombre_Lignes =
TS.ListObject.ListRows.Count
End
Function
'-----------------------------------------------------------------------------------------------
IV-B. TS_Nombre_Colonnes▲
La fonction TS_Nombre_Colonnes renvoie le nombre de colonnes du tableau structuré passé en argument.
Son argument est :
- TS : la plage (de type Range) qui représente le tableau structuré.
La fonction renvoie : le nombre de colonnes du tableau structuré.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_Nombre_Colonnes
(
TS As
Range) As
Integer
'------------------------------------------------------------------------------------------------
TS_Nombre_Colonnes =
TS.ListObject.ListColumns.Count
End
Function
'-----------------------------------------------------------------------------------------------
IV-C. TS_ValeurColonne▲
La fonction TS_ValeurColonne renvoie la valeur du calcul pour la ligne des totaux d'une colonne d’un tableau structuré.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou zéro alors la dernière colonne du tableau est traitée ;
- TypeCalcul : une valeur de l’énumération XlTotalsCalculation
- xlTotalsCalculationAverage : moyenne,
- xlTotalsCalculationCount : décompte des cellules non vides,
- xlTotalsCalculationCountNums : décompte des cellules contenant des valeurs numériques,
- xlTotalsCalculationMax : valeur maximale dans la liste,
- xlTotalsCalculationMin : valeur minimale dans la liste,
- xlTotalsCalculationStdDev : calcul l’écart-type standard,
- xlTotalsCalculationSum : somme,
- xlTotalsCalculationVar = (personalisé) nombre de cellules non numériques,
- xlTotalsCalculationNone = (personnalisé) nombre de cellules vides ; - CellulesVisiblesUniquement :
True
pour ne pour ne traiter que les cellules visibles,False
pour traiter toutes les cellules (y compris les filtrées et masquées).
La fonction renvoie : la valeur du calcul demandé ou Null
si erreur.
Exemple pour obtenir la note moyenne des élèves (y compris les éléments filtrés) :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Dim
Moyenne As
Double
Moyenne =
TS_ValeurColonne
(
Tableau, "Note"
, xlTotalsCalculationAverage, False
)
End
Sub
'------------------------------------------------------------------------------------------------
Remarque : vous pouvez aussi utiliser les fonctions d'Excel, par exemple :
Application.Evaluate
(
"=COUNTIF(Tableau[Note],"">10"")"
) : nombre de notes supérieures à 10.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ValeurColonne
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
TypeCalcul As
XlTotalsCalculation, _
CellulesVisiblesUniquement As
Boolean
) As
Variant
'------------------------------------------------------------------------------------------------
' Renvoie la valeur d'une colonne.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' TypeCalcul : Type de calcul à appliquer suivant l'énumération XlTotalsCalculation.
' xlTotalsCalculationAverage = Moyenne.
' xlTotalsCalculationCount = Nombre de cellules non vides.
' xlTotalsCalculationCountNums = Nombre de cellules avec des valeurs numériques.
' xlTotalsCalculationMax = Valeur numérique maximale.
' xlTotalsCalculationMin = Valeur numérique minimale.
' xlTotalsCalculationStdDev = Écart type standard.
' xlTotalsCalculationSum = Somme.
' xlTotalsCalculationVar = (Personnalisé) Nombre de cellules non numériques.
' xlTotalsCalculationNone = (personnalisé) Nombre de cellules vides.
' CellulesVisiblesUniquement : VRAI pour ne calculer que les cellules visibles.
'------------------------------------------------------------------------------------------------
' Renvoie : la valeur concernée en prenant en compte les lignes filtrées ou non, au choix,
' ou Null si erreur (valeur non numérique).
'------------------------------------------------------------------------------------------------
Dim
CalculationNone As
Long
Dim
CalculationVar As
Long
Dim
PlageCalcul As
Range, Fx As
Integer
Dim
Ligne As
Long
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Par défaut renvoyer Null:
TS_ValeurColonne =
Null
' S'il faut calculer les cellules visibles uniqement (non filtrées) pour les 7 opérateurs classiques,
' il est possible d'utiliser Application.Subtotal:
If
CellulesVisiblesUniquement =
True
Then
' Définit la plage de calcul:
Set
PlageCalcul =
TS.ListObject.ListColumns
(
Colonne).DataBodyRange
Select
Case
TypeCalcul
Case
xlTotalsCalculationAverage: Fx =
1
Case
xlTotalsCalculationCount: Fx =
3
Case
xlTotalsCalculationCountNums: Fx =
2
Case
xlTotalsCalculationMax: Fx =
4
Case
xlTotalsCalculationMin: Fx =
5
Case
xlTotalsCalculationStdDev: Fx =
7
Case
xlTotalsCalculationSum: Fx =
9
End
Select
If
Fx <>
0
Then
TS_ValeurColonne =
Application.Subtotal
(
Fx, PlageCalcul)
End
If
' S'il faut calculer toutes les cellules (y compris les filtrées) pour les 7 opérateurs
' classiques, et xlTotalsCalculationNone, il est possible d'utiliser les fonctions "Application":
If
CellulesVisiblesUniquement =
False
Then
' Définit la plage de calcul:
Set
PlageCalcul =
TS.ListObject.ListColumns
(
Colonne).DataBodyRange
Select
Case
TypeCalcul
Case
xlTotalsCalculationAverage: TS_ValeurColonne =
Application.Average
(
PlageCalcul)
Case
xlTotalsCalculationCount: TS_ValeurColonne =
Application.CountA
(
PlageCalcul)
Case
xlTotalsCalculationCountNums: TS_ValeurColonne =
Application.Count
(
PlageCalcul)
Case
xlTotalsCalculationMax: TS_ValeurColonne =
Application.Max
(
PlageCalcul)
Case
xlTotalsCalculationMin: TS_ValeurColonne =
Application.Min
(
PlageCalcul)
Case
xlTotalsCalculationStdDev: TS_ValeurColonne =
Application.StDev
(
PlageCalcul)
Case
xlTotalsCalculationSum: TS_ValeurColonne =
Application.Sum
(
PlageCalcul)
Case
xlTotalsCalculationNone: TS_ValeurColonne =
Application.CountBlank
(
PlageCalcul)
End
Select
End
If
' Pour les cas personnalisés :
' xlTotalsCalculationVar = Nombre de cellules non numériques.
' xlTotalsCalculationNone = Nombre de cellules vides.
If
IsNull
(
TS_ValeurColonne) Then
' Boucle sur les données de la colonne:
For
Ligne =
1
To
TS.ListObject.ListRows.Count
' Traitement de la cellule de la colonne:
With
TS.ListObject.DataBodyRange
(
Ligne, Colonne)
' Si la ligne est visible ou non (sa hauteur vaut 0) et suivant le cas demandé:
If
(
.Height
<>
(
CellulesVisiblesUniquement Xor
-
1
)) Then
' Si la ligne est non vide:
If
.Value
<>
""
Then
' Si la cellule n'est pas numérique:
If
IsNumeric
(
.Value
) =
False
Then
CalculationVar =
CalculationVar +
1
Else
' Si la cellule est vide:
CalculationNone =
CalculationNone +
1
End
If
End
If
End
With
Next
Ligne
' Renvoie le résultat suivant le calcul demandé:
Select
Case
TypeCalcul
Case
xlTotalsCalculationNone
TS_ValeurColonne =
CalculationNone
Case
xlTotalsCalculationVar
TS_ValeurColonne =
CalculationVar
End
Select
End
If
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ValeurColonne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ValeurColonne"
End
If
Err
.Clear
End
Function
'-----------------------------------------------------------------------------------------------
IV-D. TS_InfoCellule▲
La fonction TS_InfoCellule renvoie des informations sur une cellule d’un tableau structuré, même si elle est masquée.
La cellule concernée est identifiée par sa position dans le tableau structuré. La première colonne vaut 1 (il est conseillé d’utiliser le nom de la colonne au lieu de son numéro), la première ligne vaut 1.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou zéro alors la dernière colonne du tableau est traitée ;
- Ligne : la ligne concernée. Si cette valeur est zéro alors prend la dernière ligne du tableau structuré. Si elle est inférieure à zéro alors prend la ligne des totaux ;
- TypeInfo : (facultatif) le type d’information désirée défini par une valeur de l’énumération personnelle Enum_InfoTS déclarée en en-tête du module
- TS_Valeur : (par défaut) renvoie la valeur de la cellule,
- TS_Formule : renvoie la formule de la cellule,
- TS_CouleurTexte : renvoie la couleur de texte de la cellule,
- TS_CouleurFond : renvoie la couleur de fond de la cellule,
- TS_Gras : renvoieTrue
si la cellule est en gras etFalse
dans le cas contraire,
- TS_Italique : renvoieTrue
si la cellule est en italique etFalse
dans le cas contraire,
- TS_Visible : renvoieTrue
si la cellule est visible etFalse
dans le cas contraire,
- TS_Format : renvoie le format de la cellule,
- TS_Commentaire : renvoie le commentaire de la cellule,
- TS_LienHypertexte : renvoie le lien hypertexte de la cellule.
La fonction renvoie l’information sur la cellule suivant l’option demandée, même si elle est masquée.
Exemple pour boucler sur les lignes du tableau structuré « TS_Eleves » et afficher dans le débogueur leur note :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Dim
Ligne As
Long
For
Ligne =
1
To
TS_Nombre_Lignes
(
Tableau)
Debug.Print
TS_InfoCellule
(
Tableau, "Note"
, Ligne, TS_Valeur)
Next
Ligne
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_InfoCellule
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
ByVal
Ligne As
Long
, _
Optional
TypeInfo As
Enum_InfoTS =
TS_Valeur) As
Variant
'------------------------------------------------------------------------------------------------
' Renvoie une information sur la cellule d'une ligne d'une colonne (même si elle est masquée).
' L'information peut être la valeur ou la formule ou la couleur du texte...
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Ligne : la ligne concernée.
' Si 0 alors prend la dernière ligne du Tableau Structuré.
' Si <0 alors prend la ligne des totaux.
' TypeInfo : type d'information à renvoyer, voir l'énumération Enum_InfoTS.
' TS_Valeur : renvoie la valeur de la cellule.
' TS_Formule : renvoie la formule de la cellule.
' TS_CouleurTexte : renvoie la couleur de texte de la cellule.
' TS_CouleurFond : renvoie la couleur de fond de la cellule.
' TS_Gras : renvoie Vrai si la cellule est en gras.
' TS_Italique : renvoie Vrai si la cellule est en italique.
' TS_Visible : renvoie Vrai si la cellule est visible.
' TS_Format : renvoie le format de la cellule.
' TS_Commentaire : renvoie le commentaire de la cellule.
' TS_LienHypertexte : renvoie le lien hypertexte de la cellule.
'------------------------------------------------------------------------------------------------
' Renvoie l'information désirée sur la cellule.
'------------------------------------------------------------------------------------------------
Dim
Anc_ShowTotals As
Boolean
Dim
Anc_ScreenUpdating As
Boolean
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Contrôle la cohérence de la ligne passée en argument:
If
Ligne >=
0
Then
Ligne =
TS_IndexLigne
(
TS, Ligne)
If
Ligne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
End
If
' S'il faut traiter les totaux alors force l'affichage des totaux:
If
Ligne <
0
Then
Anc_ShowTotals =
TS.ListObject.ShowTotals
Anc_ScreenUpdating =
Application.ScreenUpdating
Ligne =
TS.ListObject.ListRows.Count
+
1
Application.ScreenUpdating
=
False
TS.ListObject.ShowTotals
=
True
End
If
' Traitement:
With
TS.ListObject.DataBodyRange
(
Ligne, Colonne)
Select
Case
TypeInfo
Case
TS_valeur
TS_InfoCellule =
.Value
Case
TS_Formule
TS_InfoCellule =
.Formula
Case
TS_CouleurTexte
TS_InfoCellule =
.Font.Color
Case
TS_CouleurFond
TS_InfoCellule =
.Interior.Color
Case
TS_Gras
TS_InfoCellule =
.Font.Bold
Case
TS_Italique
TS_InfoCellule =
.Font.Italic
Case
TS_Visible
If
.Height
>
0
Then
TS_InfoCellule =
True
Else
TS_InfoCellule =
False
Case
TS_Format
TS_InfoCellule =
.NumberFormat
Case
TS_Commentaire
If
Not
.Comment
Is
Nothing
Then
TS_InfoCellule =
.Comment.Text
End
If
Case
TS_LienHypertexte
If
.Hyperlinks.Count
>
0
Then
TS_InfoCellule =
.Hyperlinks
(
1
).Name
End
If
End
Select
End
With
' Restaure l'état de l'affichage des totaux:
If
Ligne >
TS.ListObject.ListRows.Count
Then
TS.ListObject.ShowTotals
=
Anc_ShowTotals
Application.ScreenUpdating
=
Anc_ScreenUpdating
End
If
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_InfoCellule"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_InfoCellule"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
V. Rechercher, sélectionner, modifier les données d’un tableau structuré▲
Les différentes fonctions de ce chapitre permettent de rechercher, sélectionner ou modifier les données d’un tableau structuré.
V-A. TS_Rechercher▲
La fonction TS_Rechercher recherche une donnée et renvoie le numéro de la ligne où elle se trouve.
La recherche peut comporter jusqu’à 16 colonnes dans ses critères.
Les lignes masquées sont incluses dans la recherche.
Les critères peuvent être passés « en dur » ou par un tableau.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- RespecterCasse :
True
pour respecter la casse ouFalse
pour l’ignorer ; - ListeColonnesValeurs : la liste des colonnes et valeurs de type ParamArray (tableau de paramètres), séparées par une virgule.
La fonction renvoie : le numéro de la ligne qui correspond aux critères de recherche ou zéro si rien n’est trouvé.
Exemple pour rechercher la ligne où se trouve l’élève dont le nom est « TINE » et le prénom « Clément » (en respectant la casse) :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Dim
Ligne As
Long
Ligne =
TS_Rechercher
(
Tableau, True
, "Nom"
, "TINE"
, "Prénom"
, "Clément"
)
End
Sub
'------------------------------------------------------------------------------------------------
Exemple pour rechercher la même chose mais les critères sont passés en utilisant un tableau :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Dim
Ligne As
Long
Dim
T
(
1
To
4
) As
Variant
T
(
1
) =
"Nom"
T
(
2
) =
"TINE"
T
(
3
) =
"Prénom"
T
(
4
) =
"Clément"
Ligne =
TS_Rechercher
(
Tableau, True
, T)
End
Sub
'------------------------------------------------------------------------------------------------
Remarque : pour une recherche de date, pensez à convertir la date en valeur par l’instruction DateValue
(
MaDate)
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_Rechercher
(
TS As
Range, _
RespecterCasse As
Boolean
, _
ParamArray ListeColonnesValeurs
(
) As
Variant
) As
Long
'-----------------------------------------------------------------------------------------------
' Recherche une valeur dans un Tableau Structuré.
'-----------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' RespecterCasse As Boolean : True pour respecter la casse ou False pour l'ignorer.
' ListeColonnesValeurs : La liste des colonnes et valeurs de type ParamArray (tableau de paramètres).
' Un ParamArray est limité à 32 arguments (séparés par une virgule), donc 16 couples.
'-----------------------------------------------------------------------------------------------
' Renvoie : la 1ère ligne trouvée ou 0 si rien n'est trouvé.
'------------------------------------------------------------------------------------------------
Dim
i As
Integer
, Ligne As
Long
, ik As
Integer
, Trouvé As
Boolean
Dim
Arguments
(
) As
Variant
Dim
Colonne
(
) As
Variant
Dim
Valeur
(
) As
Variant
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Si ListeColonnesValeurs est passé en programmation:
If
UBound
(
ListeColonnesValeurs) =
0
Then
ReDim
Arguments
(
LBound
(
ListeColonnesValeurs
(
0
)) To
UBound
(
ListeColonnesValeurs
(
0
)))
For
ik =
LBound
(
Arguments) To
UBound
(
Arguments)
Arguments
(
ik) =
ListeColonnesValeurs
(
0
)(
ik)
Next
ik
End
If
' Si ListeColonnesValeurs est passé en dure:
If
UBound
(
ListeColonnesValeurs) >
0
Then
ReDim
Arguments
(
LBound
(
ListeColonnesValeurs) To
UBound
(
ListeColonnesValeurs))
For
ik =
LBound
(
Arguments) To
UBound
(
Arguments)
Arguments
(
ik) =
ListeColonnesValeurs
(
ik)
Next
ik
End
If
' Chargement des colonnes:
ik =
LBound
(
Arguments)
For
i =
LBound
(
Arguments) To
UBound
(
Arguments) Step
2
ReDim
Preserve
Colonne
(
LBound
(
Arguments) To
ik)
Colonne
(
ik) =
TS_IndexColonne
(
TS, Arguments
(
i))
If
Colonne
(
ik) =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
ik =
ik +
1
Next
i
' Chargement des valeurs:
ik =
LBound
(
Arguments)
For
i =
LBound
(
Arguments) To
UBound
(
Arguments) Step
2
ReDim
Preserve
Valeur
(
LBound
(
Arguments) To
ik)
Valeur
(
ik) =
Arguments
(
i +
1
)
If
TypeName
(
Arguments
(
i +
1
)) <>
"String"
Then
Valeur
(
ik) =
CDec
(
Valeur
(
ik))
ik =
ik +
1
Next
i
' Recherche dans toutes les lignes du Tableau Structuré les couples Colonne/valeur:
For
Ligne =
1
To
TS.ListObject.ListRows.Count
Trouvé =
True
Select
Case
RespecterCasse
Case
True
For
i =
LBound
(
Colonne) To
UBound
(
Colonne)
If
TS.ListObject.DataBodyRange
(
Ligne, Colonne
(
i)).Value
<>
Valeur
(
i) Then
Trouvé =
False
Exit
For
End
If
Next
i
Case
False
For
i =
LBound
(
Colonne) To
UBound
(
Colonne)
If
UCase
(
TS.ListObject.DataBodyRange
(
Ligne, Colonne
(
i)).Value
) <>
UCase
(
Valeur
(
i)) Then
Trouvé =
False
Exit
For
End
If
Next
i
End
Select
If
Trouvé =
True
Then
TS_Rechercher =
Ligne
Exit
For
End
If
Next
Ligne
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_Rechercher"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_Rechercher"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
V-B. TS_RechercherVisible▲
La fonction TS_RechercherVisible recherche une valeur dans une colonne d'un tableau structuré uniquement pour les lignes visibles et renvoie la ligne trouvée.
En option vous pouvez indiquer si la recherche doit respecter ou non la casse et s'il faut ou non une correspondance exacte.
Par défaut la fonction renvoie le numéro de la première ligne trouvée ou zéro si rien n’est trouvé, mais vous pouvez aussi lui demander de renvoyer la valeur de la colonne de votre choix (équivalent à RechercheV), ou la valeur à renvoyer si la recherche est infructueuse.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le numéro de la colonne ou le nom de la colonne concernée, ou 0 pour traiter la dernière colonne ;
- ValeurCherchée : la valeur qu'il faut chercher ;
- RespecterCasse :
True
pour respecter la casse ouFalse
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. - Correspondance : (facultatif) indique le mode de recherche :
- xlWhole : (par défaut) détecte une correspondance avec l'ensemble du texte recherché,
- xlPart : détecte une correspondance avec une partie du texte recherché ; - ColonneRenvoyée : (facultatif) le nom ou le numéro de la colonne concernée. Si ce numéro est zéro, alors la dernière colonne du tableau structuré est traitée ;
- ValeurSiNonTRouvé : (facultatif) la valeur à renvoyer si la recherche ne trouve rien.
La fonction renvoie :
- - si ColonneRenvoyée <0 : Le numéro de la 1ère ligne trouvée ou 0 si rien n'est trouvé ;
- - si ColonneRenvoyée >= 0 : La valeur contenue dans la colonne indiquée pour la ligne trouvée, ou la valeur de l'argument ValeurSiNonTRouvé si rien n'est trouvé.
Exemple pour rechercher la ligne où se trouve l’élève dont le nom est « FIL » dans un tableau nommé « TS_Eleves » en respectant la casse :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Dim
Ligne As
Long
Ligne =
TS_RechercherVisible
(
Tableau, "Nom"
, "FIL"
, True
, TS_Valeurs)
End
Sub
'------------------------------------------------------------------------------------------------
Remarque : Cette fonction est plus rapide que la fonction TS_Rechercher car elle utilise la propriété Find au lieu d'une boucle sur les lignes du tableau.
Elle permet aussi de ne faire la recherche que sur les lignes visibles. En contrepartie la recherche ne porte que sur une colonne.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_RechercherVisible
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
ValeurCherchée As
Variant
, _
RespecterCasse As
Boolean
, _
ValeursOuFormules As
Enum_ValeursOuFormules, _
Optional
Correspondance As
XlLookAt =
xlWhole, _
Optional
ByVal
ColonneRenvoyée As
Variant
=
-
1
, _
Optional
ValeurSiNonTRouvé As
Variant
=
"#N/A"
) As
Variant
'-----------------------------------------------------------------------------------------------
' Recherche une valeur dans une colonne d'un Tableau Structuré uniquement pour les lignes visibles
' et renvoie la ligne trouvée.
' La recherche respecte la casse si RespecterCasse = True.
'-----------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' ValeurCherchée : La valeur recherchée.
' RespecterCasse As Boolean : True pour respecter la casse ou False pour l'ignorer.
' ValeursOuFormules : énumération Enum_ValeursOuFormules =
' TS_Valeurs : en valeurs.
' TS_Formules : en formules.
' Correspondance : Indique le mode de recherche :
' xlPart : Détecte une correspondance avec une partie du texte recherché.
' xlWhole : Détecte une correspondance avec l'ensemble du texte recherché.
' ColonneRenvoyée : Si >=0 alors le numéro de la colonne, ou le nom de la colonne, dont il faut
' renvoyer le contenu.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' ValeurSiNonTRouvé : La valeur renvoyée si l'élément recherché n'est pas trouvé.
'-----------------------------------------------------------------------------------------------
' Renvoie :
' Si ColonneRenvoyée < 0 : Le numéro de la 1ère ligne trouvée ou 0 si rien n'est trouvé.
' Si ColonneRenvoyée >= 0 : La valeur contenue dans la colonne indiquée pour la ligne trouvée,
' ou la valeur de l'argument ValeurSiNonTRouvé si rien n'est trouvé.
'------------------------------------------------------------------------------------------------
' Remarque : voir la documentation sur "Find" pour plus d'informations.
' https://learn.microsoft.com/fr-fr/office/vba/api/excel.xlfindlookin
'------------------------------------------------------------------------------------------------
' Exemple de recherche du nom "FIL" dans un tableau nommé "TS_X" et renvoyer la ligne concernée:
' Debug.Print TS_RechercherVisible(Range("TS_X"), "Nom", "FIL", True, TS_Valeurs)
' Exemple pour renvoyer dans la variable "X" la note de "TINE":
' X = TS_RechercherVisible(Range("TS_X"), "Nom", "TINE", True, TS_Valeurs, xlWhole, "Note", "Aucune note")
'------------------------------------------------------------------------------------------------
Dim
Rg As
Range
Dim
Lookin As
Long
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Valeur de renvoi par défaut:
TS_RechercherVisible =
0
' Recherche par formule ou valeur:
Select
Case
ValeursOuFormules
Case
TS_Valeurs: Lookin =
xlValues
Case
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, LookAt:=
Correspondance)
If
Not
Rg Is
Nothing
Then
TS_RechercherVisible =
Rg.Row
-
TS.Row
+
1
' S'il faut renvoyer la valeur de la colonne de la ligne:
If
ColonneRenvoyée >=
0
Then
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
ColonneRenvoyée =
TS_IndexColonne
(
TS, ColonneRenvoyée)
If
ColonneRenvoyée =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Suivant que l'élément recherché a été trouvé ou non:
Select
Case
TS_RechercherVisible
Case
0
: TS_RechercherVisible =
ValeurSiNonTRouvé
Case
Else
: TS_RechercherVisible =
TS_InfoCellule
(
TS, ColonneRenvoyée, TS_RechercherVisible)
End
Select
End
If
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_RechercherVisible"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_RechercherVisible"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
V-C. TS_Remplacer▲
La fonction TS_Remplacer remplace une valeur dans une colonne d'un tableau structuré.
Attention :
- si le tableau est sur la feuille active les cellules masquées ne sont pas traitées ;
- si le tableau n'est pas sur la feuille active les cellules masquées sont traitées.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le numéro de la colonne ou le nom de la colonne concernée, ou 0 pour traiter la dernière colonne ;
- ValeurCherchée : la valeur qu'il faut remplacer ;
- ValeurRemplacement : la valeur de remplacement ;
- RespecterCasse :
True
pour respecter la casse ouFalse
pour l’ignorer ; - Correspondance : (facultatif) Indique le mode de recherche :
- xlPart : détecte une correspondance avec une partie du texte recherché,
- xlWhole : (valeur par défaut) détecte une correspondance avec l'ensemble du texte recherché.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour remplacer toutes les notes 14 par 15 dans le champ « Note » un tableau nommé « TS_Eleves » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_Remplacer
(
Tableau, "Note"
, 14
, 15
, True
)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_Remplacer
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
ValeurCherchée As
Variant
, _
ValeurRemplacement As
Variant
, _
RespecterCasse As
Boolean
, _
Optional
Correspondance As
XlLookAt =
xlWhole) As
Boolean
'-----------------------------------------------------------------------------------------------
' Remplace une valeur dans une colonne d'un Tableau Structuré.
' Si le tableau est sur la feuille active les cellules masquées ne sont pas traitées.
' Si le tableau n'est pas sur la feuille active les cellules masquées sont traitées.
' La recherche/remplacement respecte la casse si RespecterCasse = True.
'-----------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' ValeurCherchée : La valeur à remplacer.
' ValeurRemplacement : La valeur de remplacement.
' RespecterCasse As Boolean : True pour respecter la casse ou False pour l'ignorer.
' Correspondance : Indique le mode de recherche :
' xlPart : Détecte une correspondance avec une partie du texte recherché.
' xlWhole : Détecte une correspondance avec l'ensemble du texte recherché.
'-----------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé, ou FAUX en cas d'erreur.
'------------------------------------------------------------------------------------------------
' Remarque : voir la documentation sur "Replace" pour plus d'informations.
' https://learn.microsoft.com/fr-fr/office/vba/api/excel.range.replace
'------------------------------------------------------------------------------------------------
' Exemples pour remplacer la valeur 14 dans le champ "Note" par la valeur 15:
' Debug.Print TS_Remplacer(Range("TS_X"), "Note", 14, 15, True)
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Lance le remplacement avec la méthode Replace:
TS.ListObject.ListColumns
(
Colonne).DataBodyRange.Replace
_
What:=
ValeurCherchée, _
Replacement:=
ValeurRemplacement, _
LookAt:=
Correspondance, SearchOrder:=
xlByRows, MatchCase:=
RespecterCasse, _
SearchFormat:=
False
, ReplaceFormat:=
False
' Renvoie VRAI:
TS_Remplacer =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_Remplacer"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_Remplacer"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
V-D. TS_Sélectionner▲
La fonction TS_Sélectionner sélectionne une plage dans un tableau structuré.
La plage peut être une cellule, une ligne entière, une colonne entière ou l’ensemble des données du tableau structuré.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : (facultatif) le nom ou le numéro de la colonne concernée. Si ce numéro est zéro, alors la dernière colonne du tableau structuré est traitée. Si cet argument n’est pas renseigné ou est vide, alors la ligne renseignée sera entièrement sélectionnée ;
- Ligne : (facultatif) la ligne concernée. Si cette valeur est zéro, alors la dernière ligne du tableau structuré est traitée. Si elle est inférieure à zéro, alors la ligne des totaux est traitée. Si cet argument n’est pas renseigné ou est vide, alors la colonne renseignée sera entièrement sélectionnée (juste les cellules visibles).
Si la colonne et la ligne ne sont pas renseignées, alors la sélection porte sur toutes les données du tableau structuré (juste les cellules visibles).
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Plusieurs exemples pour faire des sélections du tableau structuré des élèves, respectivement :
- l’ensemble des données visibles du tableau structuré ;
- la colonne « Nom » (juste les cellules visibles) ;
- la cellule située sur la 5e ligne de la colonne « Nom » ;
- la cellule située sur la dernière ligne de la colonne « Nom » ;
- le total de la colonne « Nom » ;
- la 5e ligne ;
- la dernière ligne ;
- la ligne des totaux.
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_Sélectionner
(
Tableau)
Call
TS_Sélectionner
(
Tableau, "Nom"
)
Call
TS_Sélectionner
(
Tableau, "Nom"
, 5
)
Call
TS_Sélectionner
(
Tableau, "Nom"
, 0
)
Call
TS_Sélectionner
(
Tableau, "Nom"
, -
1
)
Call
TS_Sélectionner
(
Tableau, ""
, 5
)
Call
TS_Sélectionner
(
Tableau, ""
, 0
)
Call
TS_Sélectionner
(
Tableau, ""
, -
1
)
End
Sub
'------------------------------------------------------------------------------------------------
Remarque : une fois les cellules sélectionnées, le programmeur peut les parcourir pour les analyser, les modifier ou leur appliquer un format, comme dans ces exemples :
'------------------------------------------------------------------------------------------------
Dim
C As
Range
Call
TS_Sélectionner
(
Tableau, "Nom"
, ""
) ' Sélectionne la colonne "Nom".
For
Each
C In
Selection
Debug.Print
C ' Affiche les noms.
Next
C
'------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------
Call
TS_Sélectionner
(
Tableau, "Note"
, ""
) ' Sélectionne la colonne "Note".
Selection.NumberFormat
=
"#0"
' Modifie le format numérique.
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_Sélectionner
(
TS As
Range, _
Optional
ByVal
Colonne As
Variant
=
""
, _
Optional
ByVal
Ligne As
Variant
) As
Boolean
'------------------------------------------------------------------------------------------------
' Sélectionne une plage dans un tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne
' Si 0 alors prend la dernière colonne du Tableau Structuré.
' Si non renseigné alors sélectionne la ligne entière renseignée.
' Ligne : la ligne concernée.
' Si 0 alors prend la dernière ligne du Tableau Structuré.
' Si <0 alors prend la ligne des totaux.
' Si non renseigné alors sélectionne la colonne entière renseignée.
' Si Colonne et Ligne ne sont pas renseignée alors sélectionne toutes les données.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une sélection a été faite.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Si la colonne et la ligne ne sont pas renseignées alors sélectionne toutes les données:
If
Colonne =
""
And
IsMissing
(
Ligne) =
True
Then
TS.ListObject.DataBodyRange.Select
TS_Sélectionner =
True
GoTo
Gest_Err
End
If
' Si la ligne n'est pas renseignée:
If
IsMissing
(
Ligne) =
True
Then
Ligne =
""
If
Ligne =
""
Then
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Sélectionner toutes les données de la colonne:
TS.ListObject.ListColumns
(
Colonne).DataBodyRange.Select
TS_Sélectionner =
True
' Quitte le traitement:
GoTo
Gest_Err
End
If
' Si la ligne est 0 alors prend la dernière ligne:
If
Ligne =
0
Then
Ligne =
TS.ListObject.ListRows.Count
' Si colonne est vide alors sélectionne toute la ligne:
If
Colonne =
""
Then
' La ligne du tableau:
If
Ligne >
0
And
Ligne <=
TS.ListObject.ListRows.Count
Then
TS.ListObject.ListRows
(
Ligne).Range.Select
TS_Sélectionner =
True
End
If
' La ligne des totaux:
If
Ligne <
0
Then
TS.ListObject.ShowTotals
=
True
TS.ListObject.TotalsRowRange.Select
TS_Sélectionner =
True
End
If
' Quitte le traitement:
GoTo
Gest_Err
End
If
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Deux cas de sélection possibles:
If
Ligne <
0
Then
' Sélectionne juste le total.
TS.ListObject.ShowTotals
=
True
TS.ListObject.Range
(
TS.ListObject.ListRows.Count
+
2
, Colonne).Select
TS_Sélectionner =
True
Else
' Sélectionne une cellule:
Ligne =
TS_IndexLigne
(
TS, CLng
(
Ligne))
If
Ligne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
TS.ListObject.Range
(
Ligne +
1
, Colonne).Select
TS_Sélectionner =
True
End
If
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_Sélectionner"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_Sélectionner"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
V-E. TS_Range▲
La fonction TS_Range renvoie une plage de données d'un tableau structuré. La plage peut être une cellule, une ligne, une colonne. La feuille du tableau structuré n'a pas besoin d'être active.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- VisibleUniquement : Si
True
seules les données visibles sont traitées, siFalse
les données masquées sont prises en compte également ; - Colonne : le numéro de la colonne, ou le nom de la colonne. Si 0 est renseigné alors prend la dernière colonne. Si la colonne n'est pas renseignée alors traite la ligne entière renseignée ;
- Ligne : la ligne concernée. Si 0 est renseigné alors prend la dernière ligne. Si inférieur à 0 alors prend la ligne des totaux. Si la ligne est non renseignée alors traite la colonne entière renseignée.
Si la colonne et la ligne ne sont pas renseignées, alors sélectionne toutes les données du tableau structuré.
La fonction renvoie : un Range de la sélection faite ou Nothing
.
Plusieurs exemples pour renvoyer un Range du tableau structuré des élèves, respectivement :
- pour renvoyer les données de la colonne « Nom » (sans l'en-tête et le total) ;
- pour renvoyer la cellule située 5e ligne de la colonne « Nom » ;
- pour renvoyer la dernière ligne de la colonne « Nom » ;
- pour renvoyer la cellule située sur la dernière ligne de la colonne « Nom » ;
- pour renvoyer le total de la colonne « Nom » ;
- pour renvoyer la 5e ligne ;
- pour renvoyer la dernière ligne ;
- pour renvoyer la ligne des totaux ;
- pour ne renvoyer que les données visibles du Tableau Structuré.
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
r as
Range
Set
r =
TS_Range
(
TS, False
, "Nom"
) ' pour renvoyer les données de la colonne "Nom" (sans l'en-tête et le total).
Set
r =
TS_Range
(
TS, False
, "Nom"
, 5
) ' pour renvoyer la cellule située 5ème ligne de la colonne "Nom"
Set
r =
TS_Range
(
TS, False
, "Nom"
, 0
) ' pour renvoyer la dernière ligne de la colonne "Nom".
Set
r =
TS_Range
(
TS, False
, "Nom"
, -
1
) ' pour renvoyer le total de la colonne "Nom".
Set
r =
TS_Range
(
TS, False
, , 5
) ' pour renvoyer la 5ème ligne.
Set
r =
TS_Range
(
TS, False
, , 0
) ' pour renvoyer la dernière ligne.
Set
r =
TS_Range
(
TS, False
, , -
1
) ' pour renvoyer la ligne des totaux.
Set
r =
TS_Range
(
TS, True
) ' pour ne renvoyer que les données visibles du Tableau Structuré.
' Vous pouvez utilise r comme une plage ordinaire, exemples:
' r.Count/r.Columns.Count = nombre le lignes, r.Columns.Count = nombre de colonnes,
' r.Cells(1, 1).Value = valeur cellule.
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_Range
(
TS As
Range, _
VisibleUniquement As
Boolean
, _
Optional
ByVal
Colonne As
Variant
=
""
, _
Optional
ByVal
Ligne As
Variant
) As
Range
'------------------------------------------------------------------------------------------------
' Renvoie une plage de données d'un tableau Structuré.
' La plage peut être une cellule, une ligne, une colonne.
' Remarque : La feuille du tableau structuré n'a pas besoin d'être active.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' VisibleUniquement : Si VRAI ne traite que les lignes visibles.
' Colonne : Le numéro de la colonne, ou le nom de la colonne
' Si 0 alors prend la dernière colonne du Tableau Structuré.
' Si non renseigné alors traite la ligne entière renseignée.
' Ligne : La ligne concernée.
' Si 0 alors prend la dernière ligne du Tableau Structuré.
' Si <0 alors prend la ligne des totaux.
' Si non renseigné alors traite la colonne entière renseignée.
' Si Colonne et Ligne ne sont pas renseignée alors sélectionne toutes les données.
'------------------------------------------------------------------------------------------------
' Renvoie : Un range de la sélection faite ou Nothing.
'------------------------------------------------------------------------------------------------
Dim
R As
Range
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Si la colonne et la ligne ne sont pas renseignées alors renvoie toutes les données:
If
Colonne =
""
And
IsMissing
(
Ligne) =
True
Then
Set
R =
TS.ListObject.DataBodyRange
GoTo
Gest_Err
End
If
' Si la ligne n'est pas renseignée:
If
IsMissing
(
Ligne) =
True
Then
Ligne =
""
If
Ligne =
""
Then
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Renvoie toutes les données de la colonne:
Set
R =
TS.ListObject.ListColumns
(
Colonne).DataBodyRange
' Quitte le traitement:
GoTo
Gest_Err
End
If
' Si la ligne est 0 alors prend la dernière ligne:
If
Ligne =
0
Then
Ligne =
TS.ListObject.ListRows.Count
' Si colonne est vide alors renvoie toute la ligne:
If
Colonne =
""
Then
' La ligne du tableau:
If
Ligne >
0
And
Ligne <=
TS.ListObject.ListRows.Count
Then
Set
R =
TS.ListObject.ListRows
(
Ligne).Range
End
If
' La ligne des totaux:
If
Ligne <
0
Then
TS.ListObject.ShowTotals
=
True
Set
R =
TS.ListObject.TotalsRowRange
End
If
' Quitte le traitement:
GoTo
Gest_Err
End
If
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Deux cas de renvois possibles:
If
Ligne <
0
Then
' Renvoie juste le total.
TS.ListObject.ShowTotals
=
True
Set
R =
TS.ListObject.Range
(
TS.ListObject.ListRows.Count
+
2
, Colonne)
Else
' Renvoie une cellule:
Ligne =
TS_IndexLigne
(
TS, CLng
(
Ligne))
If
Ligne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
Set
R =
TS.ListObject.Range
(
Ligne +
1
, Colonne)
End
If
' Fin du traitement:
Gest_Err
:
' S'il faut ou non ne prendre que les cellules visibles:
If
Not
R Is
Nothing
Then
On
Error
Resume
Next
If
VisibleUniquement =
True
Then
Set
TS_Range =
R.SpecialCells
(
xlCellTypeVisible)
Else
Set
TS_Range =
R
End
If
On
Error
GoTo
0
End
If
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_Range"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_Range"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
V-F. TS_ModifCellule▲
La fonction TS_ModifCellule modifie les informations sur une cellule d’un tableau structuré, même si elle est masquée.
La cellule concernée est identifiée par sa position dans le tableau structuré. La première colonne vaut 1 (il est conseillé d’utiliser le nom de la colonne au lieu de son numéro), la première ligne vaut 1.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou zéro, alors la dernière colonne du tableau est traitée ;
- Ligne : la ligne concernée. Si cette valeur est zéro, alors prend la dernière ligne du tableau structuré. Si elle est inférieure à zéro, alors prend la ligne des totaux ;
- Valeur : la valeur de référence qui sera utilisée pour modifier la cellule ;
- TypeInfo : (facultatif) le type d’information désiré défini par une valeur de l’énumération personnelle Enum_InfoTS déclarée en en-tête du module
- TS_Valeur : (par défaut) modifie la valeur de la cellule,
- TS_Ajouter : ajoute à la valeur existante la valeur passée dans Valeur,
- TS_Soustraire : soustrait à la valeur existante la valeur passée dans Valeur,
- TS_Multiplier : multiplie la valeur existante par la valeur passée dans Valeur,
- TS_Diviser : divise la valeur existante par la valeur passée dans Valeur,
- TS_Formule : applique à la cellule la formule passée dans Valeur,
- TS_CouleurTexte : applique à la cellule la couleur de texte passée dans Valeur,
- TS_CouleurFond : applique à la cellule la couleur de fond passée dans Valeur (si Valeur est vide alors efface la couleur de fond),
- TS_Gras : met la cellule en gras ou non selon que Valeur vautTrue
ouFalse
,
- TS_Italique : met la cellule en italique ou non selon que Valeur vautTrue
ouFalse
,
- TS_Format : applique à la cellule le format passé dans Valeur,
- TS_Commentaire : applique à la cellule le commentaire passé dans Valeur ou l’efface si Valeur est vide,
- TS_ImageCommentaireJPG : applique au commentaire l'image "jpg" passée dans Valeur ou l’efface si Valeur est vide,
- TS_LienHypertexte : applique à la cellule le lien hypertexte passé dans Valeur ou l’efface si Valeur est vide ; - LargeurCommentaire : (facultatif) la largeur du commentaire (ou 0 pour la taille par défaut) ;
- HauteurCommentaire: (facultatif) la hauteur du commentaire (ou 0 pour la taille par défaut).
- Mémoire : (facultatif) la mémoire qui représente une image du tableau et où sont faites les modifications. Cela permet d'être plus rapide sur les traitements en boucle qui appellent de nombreuses fois TS_ModifCellule (même avec écran et calculs bloqués). Utilisez TypeInfo = TS_ViderMémoire pour actualiser le tableau avec cette image. Une fois vidée, la mémoire peut être réutilisée pour servir d'image à un tableau.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Plusieurs exemples pour modifier la dernière ligne de la colonne « Note » du tableau structuré des élèves, respectivement :
- pour passer la note à 15 ;
- pour ajouter 2 à la note existante ;
- pour la mettre en gras ;
- pour la mettre en rouge ;
- pour y ajouter un commentaire qui sera affiché dans une infobulle de 120 sur 20.
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_ModifCellule
(
Tableau, "Note"
, 0
, 15
)
Call
TS_ModifCellule
(
Tableau, "Note"
, 0
, 2
, TS_Ajouter)
Call
TS_ModifCellule
(
Tableau, "Note"
, 0
, True
, TS_Gras)
Call
TS_ModifCellule
(
Tableau, "Note"
, 0
, 255
, TS_CouleurTexte)
Call
TS_ModifCellule
(
Tableau, "Note"
, 0
, "De gros efforts réalisés."
, TS_Commentaire, 120
, 20
)
End
Sub
'------------------------------------------------------------------------------------------------
Remarque : cette fonction permet aussi de modifier les formules de la ligne des totaux (pour y mettre des formules personnalisées) par exemple pour avoir la moyenne des notes y compris quand des lignes sont masquées :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Call
TS_ModifCellule
(
Tableau, "Note"
, -
1
, "=SUM(TS_Eleves[Note])/COUNT(TS_Eleves[Note])"
, TS_Formule)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ModifCellule
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
ByVal
Ligne As
Long
, _
Valeur As
Variant
, _
Optional
TypeInfo As
Enum_InfoTS =
TS_Valeur, _
Optional
LargeurCommentaire As
Long
=
0
, _
Optional
HauteurCommentaire As
Long
=
0
, _
Optional
ByRef
Mémoire As
Variant
) As
Boolean
'------------------------------------------------------------------------------------------------
' Modifie une information sur la cellule même si elle est masquée.
' L'information peut être la valeur ou la formule ou la couleur du texte...
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Ligne : la ligne concernée.
' Si 0 alors prend la dernière ligne du Tableau Structuré.
' Si <0 alors prend la ligne des totaux.
' Valeur : la valeur à appliquer.
' TypeInfo : Type d'information à modifier, voir l'énumération Enum_InfoTS
' TS_Valeur : Modifie la valeur qui prend la valeur passée dans Valeur.
' TS_Ajouter : Ajoute à la valeur existante la valeur passée dans Valeur.
' TS_Soustraire : Soustrait à la valeur existante la valeur passée dans Valeur.
' TS_Multiplier : Multiplie la valeur existante par la valeur passée dans Valeur.
' TS_Diviser : Divise la valeur existante par la valeur passée dans Valeur.
' TS_Formule : Modifie la formule qui devient la formule passée dans Valeur.
' TS_CouleurTexte : Modifie la couleur de texte qui prend la valeur passée dans Valeur.
' TS_CouleurFond : Modifie la couleur de fond qui prend la valeur passée dans Valeur.
' Si valeur est vide alors efface la couleur de fond.
' TS_Gras : Si Valeur vaut Vrai alors met la cellule est en gras.
' TS_Italique : Si Valeur vaut Vrai alors met la cellule est en italique.
' TS_Format : Modifie le format de la cellule.
' TS_Commentaire : Modifie le commentaire (vide pour l'effacer).
' TS_ImageCommentaireJPG : Modifie l'image "jpg" d'un commentaire (vide pour l'effacer).
' TS_LienHypertexte : Modifie le lien Hypertexte de la cellule (vide pour l'effacer).
' LargeurCommentaire : Largeur du commentaire, ou 0 pour la taille par défaut.
' HauteurCommentaire : Hauteur du commentaire, ou 0 pour la taille par défaut.
' Mémoire : La mémoire qui représente une image du tableau et où sont faites les modifications.
' Cela permet d'être plus rapide sur les traitements en boucle qui appellent
' de nombreuses fois TS_ModifCellule (même avec écran et calculs bloqués).
' Utilisez TypeInfo = TS_ViderMémoire pour actualiser le tableau avec cette image.
' Une fois vidée, la mémoire peut être réutilisée pour servir d'image à un tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
On
Error
GoTo
Gest_Err
Err
.Clear
' Si le tableau est vierge alors il faut l'initialiser:
If
TS.ListObject.ListRows.Count
=
0
And
(
Ligne =
0
Or
Ligne =
1
) Then
Call
TS_AjouterUneLigne
(
TS, 0
)
End
If
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Deux cas de modification possibles:
If
Ligne <
0
Then
' Ligne des totaux:
Ligne =
TS.ListObject.ListRows.Count
+
1
TS.ListObject.ShowTotals
=
True
Else
' Ligne du taleau:
Ligne =
TS_IndexLigne
(
TS, Ligne)
If
Ligne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
End
If
' Utilise une mémoire cache si l'argument est renseigné:
If
IsMissing
(
Mémoire) =
False
Then
' Initialise une image du tableau si l'argument passé est vide:
If
IsEmpty
(
Mémoire) =
True
Then
Mémoire =
TS.ListObject.DataBodyRange.Formula
' Suivant le type d'action demandé:
Select
Case
TypeInfo
Case
TS_Valeur
Mémoire
(
Ligne, Colonne) =
Valeur: GoTo
Gest_Err
Case
TS_Ajouter
If
IsNumeric
(
Mémoire
(
Ligne, Colonne)) =
False
Then
_
Mémoire
(
Ligne, Colonne) =
Val
(
Mémoire
(
Ligne, Colonne))
Mémoire
(
Ligne, Colonne) =
Mémoire
(
Ligne, Colonne) +
Valeur: GoTo
Gest_Err
Case
TS_Soustraire
If
IsNumeric
(
Mémoire
(
Ligne, Colonne)) =
False
Then
_
Mémoire
(
Ligne, Colonne) =
Val
(
Mémoire
(
Ligne, Colonne))
Mémoire
(
Ligne, Colonne) =
Mémoire
(
Ligne, Colonne) -
Valeur: GoTo
Gest_Err
Case
TS_Multiplier
If
IsNumeric
(
Mémoire
(
Ligne, Colonne)) =
False
Then
_
Mémoire
(
Ligne, Colonne) =
Val
(
Mémoire
(
Ligne, Colonne))
Mémoire
(
Ligne, Colonne) =
Mémoire
(
Ligne, Colonne) *
Valeur: GoTo
Gest_Err
Case
TS_Diviser
If
IsNumeric
(
Mémoire
(
Ligne, Colonne)) =
False
Then
_
Mémoire
(
Ligne, Colonne) =
Val
(
Mémoire
(
Ligne, Colonne))
Mémoire
(
Ligne, Colonne) =
Mémoire
(
Ligne, Colonne) /
Valeur: GoTo
Gest_Err
Case
TS_Formule
Mémoire
(
Ligne, Colonne) =
Valeur: GoTo
Gest_Err
Case
TS_ViderMémoire
Dim
Filtres As
Variant
Call
TS_Filtres_Mémoriser
(
TS, Filtres) ' Mémorise les filtres.
Call
TS_Filtres_Effacer
(
TS) ' Les effaces.
TS.ListObject.DataBodyRange.Formula
=
Mémoire ' Transfert la mémoire cache dans le tableau.
Call
TS_Filtres_Restaurer
(
TS, Filtres) ' Remet les filtres.
Mémoire =
Empty
' Vide la mémoire.
End
Select
End
If
' Modifie la cellule suivant le type demandé:
With
TS.ListObject.DataBodyRange
(
Ligne, Colonne)
Select
Case
TypeInfo
Case
TS_Valeur
.Value
=
Valeur
Case
TS_Ajouter
.Value
=
.Value
+
Valeur
Case
TS_Soustraire
.Value
=
.Value
-
Valeur
Case
TS_Multiplier
.Value
=
.Value
*
Valeur
Case
TS_Diviser
.Value
=
.Value
/
Valeur
Case
TS_Formule
.Formula
=
Valeur
Case
TS_CouleurTexte
.Font.Color
=
Valeur
Case
TS_CouleurFond
If
IsNumeric
(
Valeur) =
True
Then
.Interior.Color
=
Valeur
If
Valeur =
""
Then
.Interior.Pattern
=
xlNone
Case
TS_Gras
If
Valeur =
True
Then
.Font.Bold
=
True
If
Valeur =
False
Then
.Font.Bold
=
False
Case
TS_Italique
If
Valeur =
True
Then
.Font.Italic
=
True
If
Valeur =
False
Then
.Font.Italic
=
False
Case
TS_Format
.NumberFormat
=
Valeur
Case
TS_Commentaire
.ClearComments
If
Valeur <>
""
Then
.AddComment
.Comment.Text
Text:=
Valeur
If
HauteurCommentaire >
0
Then
.Comment.Shape.Height
=
HauteurCommentaire
If
LargeurCommentaire >
0
Then
.Comment.Shape.Width
=
LargeurCommentaire
End
If
Case
TS_ImageCommentaireJPG
.ClearComments
If
Valeur <>
""
Then
.AddComment
.Comment.Shape.Fill.UserPicture
Valeur
If
HauteurCommentaire >
0
Then
.Comment.Shape.Height
=
HauteurCommentaire
If
LargeurCommentaire >
0
Then
.Comment.Shape.Width
=
LargeurCommentaire
End
If
Case
TS_LienHypertexte
.Hyperlinks.Delete
If
Valeur <>
""
Then
.Hyperlinks.Add
Anchor:=
TS.ListObject.DataBodyRange
(
Ligne, Colonne), Address:=
Valeur
End
If
End
Select
End
With
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
=
0
Then
TS_ModifCellule =
True
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ModifCellule"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ModifCellule"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
Pour accélérer les traitements de mise à jour des données il est conseillé d'utiliser Application.ScreenUpdating = False pour éviter la mise à jour de l'écran et Application.Calculation = xlCalculationManual pour bloquer les calculs.
Puis vous restaurez la situation avec Application.Calculation = xlCalculationAutomatic et Application.ScreenUpdating = True.
Il y a encore plus rapide, utilisant une mémoire cache qui représente les données du tableau structuré.
Les données sont mises à jour dans cette mémoire et à la fin du traitement le tableau est alimenté par cette mémoire.
Les traitements sont alors environ cinq fois plus rapides qu'avec l'écran et les calculs bloqués, ce qui n'est pas négligeable, et les propriétés Application.Calculation et Application.ScreenUpdating n'ont même pas besoin d'être utilisées.
La fonction TS_ModifCellule gère cela en passant dans son argument Mémoire une variable préalablement déclarée de type Variant.
Utilisez la fonction TS_ModifCellule dans vos traitements comme d'habitude sans oublier de renseigner l'argument Mémoire.
Pour basculer la mémoire dans le tableau structuré faites un nouvel appel à la fonction TS_ModifCellule en utilisant TS_ViderMémoire comme valeur de l'argument TypeInfo.
Cette appel vide la mémoire qui peut être réutilisée pour servir d'image cache à un autre tableau.
Les arguments obligatoires Colonne, Ligne et Valeur n'ont pas d'utilité et peuvent être laissés à zéro.
Dim
M As
Variant
, i As
Integer
For
i=
1
to
1000
: Call
TS_ModifCellule
(
Range
(
"Tableau1"
), 1
, 1
, 10
, TS_Ajouter, , , M): Next
i
Call
TS_ModifCellule
(
Range
(
"Tableau1"
), 0
, 0
, ""
, TS_ViderMémoire, , , M)
V-G. TS_ForcerValeurColonne▲
La fonction TS_ForcerValeurColonne met une valeur unique dans une colonne d'un tableau structuré.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée ;
- Valeur : la valeur qu'il faut utiliser ;
- VisibleUniquement : si
True
alors ne traite que les lignes visibles, siFalse
alors traite toutes les lignes même les masquées.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour mettre la valeur "Ok" dans la colonne "Admis" pour les élèves dont la note est supérieure ou égale à 10 :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves_1"
)
' Filtre les notes >= 10:
Call
TS_Filtres_Poser
(
Tableau, "Note"
, ">=10"
)
' Force la valeur OK dans la colonne "Admis" pour les lignes visibles:
Call
TS_ForcerValeurColonne
(
TS:=
Tableau, Colonne:=
"Admis"
, Valeur:=
"OK"
, VisibleUniquement:=
True
)
' Efface le filtre:
Call
TS_Filtres_Effacer
(
Tableau)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ForcerValeurColonne
(
TS As
Range, ByVal
Colonne As
Variant
, Valeur As
Variant
, VisibleUniquement As
Boolean
) As
Boolean
'------------------------------------------------------------------------------------------------------
' Met une valeur unique dans une colonne d'un tableau structuré.
' TS : le tableau structuré concerné.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Valeur : la valeur à utiliser.
' VisibleUniquement : Si VRAI ne traite que les lignes visibles.
'------------------------------------------------------------------------------------------------------
Dim
AncCalculation
Dim
AncScreenUpdating As
Boolean
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Bloque les calculs:
AncCalculation =
Application.Calculation
Application.Calculation
=
xlCalculationManual
AncScreenUpdating =
Application.ScreenUpdating
Application.ScreenUpdating
=
False
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Si la colonne n'est pas filtrée:
If
TS_Filtres_Existe
(
TS) =
False
Then
' On peut utiliser cette méthode qui est rapide:
TS.ListObject.ListColumns
(
Colonne).DataBodyRange
=
Valeur
' Renvoie VRAI:
TS_ForcerValeurColonne =
True
' Sinon il faut traiter les cellules une à une car ListColumns réagit
' différemment sur les cellules visibles ou non suivant que la feuille
' est active ou non:
Else
' Mémorise le tableau:
Dim
Mémoire As
Variant
, i As
Long
Mémoire =
TS.ListObject.DataBodyRange.Formula
' Boucle sur les lignes visibles ou toutes si VisibleUniquement = False
For
i =
1
To
TS_Nombre_Lignes
(
TS)
If
TS.ListObject.DataBodyRange
(
i, 1
).Height
>
0
Or
VisibleUniquement =
False
Then
Mémoire
(
i, Colonne) =
Valeur
End
If
Next
i
' Mise à jour du tableau d'après la mémoire (les filtres doivent être retirés):
Dim
Filtres As
Variant
Call
TS_Filtres_Mémoriser
(
TS, Filtres)
Call
TS_Filtres_Effacer
(
TS)
TS.ListObject.DataBodyRange.Formula
=
Mémoire
Call
TS_Filtres_Restaurer
(
TS, Filtres)
End
If
' Fin du traitement:
Gest_Err
:
' Restaure les calculs:
Application.Calculation
=
AncCalculation
Application.ScreenUpdating
=
AncScreenUpdating
' Erreurs:
If
Err
.Number
=
1004
Then
Err
.Clear
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ForcerValeurColonne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ForcerValeurColonne"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VI. Importer, exporter des données d’un tableau structuré▲
Ce chapitre est consacré à l’importation et l’exportation des données.
VI-A. TS_ImporterDonnées (version importation)▲
La fonction TS_ImporterDonnées permet d’importer des données depuis un autre tableau structuré en sélectionnant les critères d’importation.
Toutes les colonnes du tableau de destination qui ont une correspondance dans le tableau qui contient les données à importer sont traitées, les autres colonnes sont ignorées.
ATTENTION : Les lignes masquées du tableau structuré qui contient les données à importer ne sont pas importées. Ce qui permet (éventuellement) de faire en amont une règle de gestion des importations.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré où seront importées les données (c’est-à-dire le tableau destination) ;
- TD : la plage (de type Range) qui représente le tableau structuré source d’où proviennent les données ;
- Méthode : la méthode d’importation désirée définie par une valeur de l’énumération personnelle Enum_ImportationTS déclarée en en-tête du module
- TS_Ajout_Forcé : ajoute les lignes au tableau d'origine même si elles existent déjà (dans ce cas laissez ListeColonnesClés à vide),
- TS_MAJ_Uniquement : ne fait que des mises à jour et refuse les ajouts,
- TS_MAJ_Ou_Ajout : fait une mise à jour si possible ou un ajout si la donnée est nouvelle,
- TS_IgnorerSiExiste : ne tient pas compte de la donnée si elle existe déjà ; - RespecterCasse :
True
pour respecter la casse ouFalse
pour l’ignorer ; - ListeColonnesClés : la liste des colonnes (en-tête) qui servent de clés de référence dans la comparaison des mises à jour, de type ParamArray (tableau de paramètres), séparées par une virgule.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Remarque : l’importation nécessite que les deux tableaux aient en commun les champs utilisés pour la clé.
Exemple d’importation de données pour mettre à jour les notes des élèves du tableau structuré d’origine « TS_Eleves » (tableau de gauche) et y ajouter les nouveaux élèves, avec les données du tableau structuré « Données » (tableau de droite) :
Les clés seront « Nom » et « Prénom », champs présents dans les deux tableaux (l’ordre n’a pas d’importance).
La colonne « Note », présente dans les deux tableaux sera traitée et mettra à jour le tableau d’origine, inversement, la colonne « Date » sera ignorée puisque qu’elle n’a pas de correspondance dans le tableau d’origine (une importation serait possible si l’on ajoutait ce champ au tableau d’origine, il n’y a pas de limite dans le nombre de colonnes qui peuvent être mises à jour).
La méthode d’importation sera « TS_MAJ_Ou_Ajout » pour mettre à jour la note des élèves existants et ajouter les nouveaux élèves.
La casse sera ignorée car les données à importer ont parfois un format différent.
Les éventuels filtres du tableau structuré « Données » seront effacés pour importer toutes les données.
En cas d’erreur de traitement, un message le signale :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Dim
TD As
Range
Set
TD =
Range
(
"Données"
)
' Efface les éventuels filtres sur le tableau des données à importer :
Call
TS_Filtres_Effacer
(
TD)
' Importe les données suivant les clés Nom et Prénom, renvoie False en cas d’erreur et l’affiche :
If
TS_ImporterDonnées
(
Tableau, TD, TS_MAJ_Ou_Ajout, False
, "Nom"
, "prénom"
) =
False
Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbCritical
, "Erreur de traitement"
End
If
End
Sub
'------------------------------------------------------------------------------------------------
Ce qui donne :
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ImporterDonnées
(
TS As
Range, _
TD As
Range, _
Méthode As
Enum_ImportationTS, _
RespecterCasse As
Boolean
, _
ParamArray ListeColonnesClés
(
) As
Variant
) As
Boolean
'------------------------------------------------------------------------------------------------
' Permet l'importation de données depuis un Tableau Structuré pour alimenter
' le Tableau Structuré d'origine.
' Toutes les colonnes du tableau d'origine qui ont une correspondance dans le tableau qui contient
' les données à importer sont traitées.
'------------------------------------------------------------------------------------------------
' ATTENTION : les lignes masquées du Tableau Structuré qui contient les données à importer
' ~~~~~~~~~~ ne sont pas importées. Ce qui permet (éventuellement) de faire en amont une règle
' de gestion des importations.
'------------------------------------------------------------------------------------------------
' TS : le Tableau Structuré d'origine.
' TD : le Tableau Structuré qui contient les données à importer.
' Méthode : la méthode d'importation
' TS_Ajout_Forcé : Ajoute les lignes au tableau d'origine même si elles existent déjà, dans
' ce cas mettre "" pour ListeColonnesClés.
' TS_MAJ_Uniquement : Ne fait que des mises à jour et refuse les ajouts.
' TS_MAJ_Ou_Ajout : Fait une mise à jour si possible ou un ajout si la donnée est nouvelle.
' TS_IgnorerSiExiste : Ne tient pas compte de la donnée si elle existe déjà.
' RespecterCasse As Boolean : True pour respecter la casse ou False pour l'ignorer.
' ListeColonnesClés : la liste des colonnes (en-tête) qui sert de clé de référence dans la comparaison
' des mises à jour, de type ParamArray (tableau de paramètres).
' Passez en argument soit le nom soit le numéro de la colonne.
' Un ParamArray est limité à 32 arguments, séparés par une virgule.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim
x As
Integer
, i As
Integer
, y As
Long
, yy As
Long
, NomColonne As
String
Dim
Ajout As
Boolean
Dim
Arguments
(
) As
Variant
Dim
NbClé As
Integer
Dim
MesFiltres As
Variant
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Mémorise les éventuels filtres et les retire:
Call
TS_Filtres_Mémoriser
(
TS, MesFiltres)
Call
TS_Filtres_Effacer
(
TS)
' S'il y a des colonnes renseignées pour former une clé:
If
IsMissing
(
ListeColonnesClés) =
False
Then
NbClé =
(
UBound
(
ListeColonnesClés) +
1
) *
2
ReDim
Arguments
(
1
To
NbClé)
x =
1
For
i =
0
To
UBound
(
ListeColonnesClés)
Arguments
(
x) =
ListeColonnesClés
(
i)
If
IsNumeric
(
Arguments
(
x)) =
True
Then
_
Arguments
(
x) =
TS.ListObject.ListColumns
(
Arguments
(
x)).Name
x =
x +
2
Next
i
End
If
' Boucle sur les lignes du Tableau Structuré à importer :
For
y =
1
To
TD.ListObject.ListRows.Count
Ajout =
False
yy =
0
' Si la ligne est masquée alors passer à la suivante:
If
TD.ListObject.DataBodyRange
(
y, 1
).Height
=
0
Then
GoTo
Suite_Y
' Si une recherche sur les titres:
If
NbClé >
0
And
Méthode <>
TS_Ajout_Forcé Then
For
i =
2
To
NbClé Step
2
' Renvoie la valeur de la colonne clé:
Arguments
(
i) =
TS_InfoCellule
(
TD, Arguments
(
i -
1
), y, TS_valeur)
' Si la clé n'existe pas:
If
TS_Err_Number <>
0
Then
Err
.Raise
TS_Err_Number, , TS_Err_Description
Next
i
' Si la clé est trouvée dans le tableau destination alors ne pas
' ajouter une ligne mais travailler sur la ligne trouvée = yy.
' La recherche tient compte de la casse ou non:
yy =
TS_Rechercher
(
TS, RespecterCasse, Arguments)
If
yy <>
0
Then
Ajout =
True
If
TS_Err_Number <>
0
Then
Err
.Raise
TS_Err_Number, , TS_Err_Description
' Si l'on ne doit faire que des mises à jour alors passer à la suite
' si la donnée n'est pas trouvée dans le tableau destination:
If
Méthode =
TS_MAJ_Uniquement And
yy =
0
Then
GoTo
Suite_Y
' Si l'on doit ignorer les données qui existe déjà alors passer
' à la suite si la donnée est trouvée dans le tableau destination:
If
Méthode =
TS_IgnorerSiExiste And
yy <>
0
Then
GoTo
Suite_Y
End
If
' Boucle sur les colonnes:
For
x =
1
To
TD.ListObject.ListColumns.Count
' Récupère le nom de la colonne:
NomColonne =
TD.ListObject.HeaderRowRange
(
x).Value
' Vérifie si elle exite dans le tableau destination:
If
TS_IndexColonne
(
TS, NomColonne) >
-
1
Then
' S'il faut ajouter une ligne:
If
Ajout =
False
Then
Ajout =
True
TS.ListObject.ListRows.Add
yy =
0
End
If
' Ajoute la donnée au tableau destination:
Call
TS_ModifCellule
(
TS, NomColonne, yy, TD.ListObject.DataBodyRange
(
y, x).Value
, TS_Valeur)
End
If
Next
x
Suite_Y
:
Next
y
' Restaure les filtres et l'affichage:
Call
TS_Filtres_Restaurer
(
TS, MesFiltres)
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
=
0
Then
TS_ImporterDonnées =
True
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ImporterDonnées"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ImporterDonnées"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VI-B. TS_ImporterDonnées (version exportation)▲
La fonction TS_ImporterDonnées permet aussi d’exporter des données vers un autre tableau structuré.
Puisque ce qui est une importation pour l’un est une exportation pour l’autre.
ATTENTION : Les lignes masquées du tableau structuré qui contient les données à exporter ne sont pas exportées. Ce qui permet (éventuellement) de faire en amont une règle de gestion des importations.
Exemple d’exportation des données du tableau des élèves pour avoir une liste sans doublon des noms dans un nouveau tableau structuré sur la feuille « Feuil2 » qui sera nommé « Tableau_Noms » :
La clé sera le « Nom ».
La méthode sera « TS_MAJ_Ou_Ajout » pour éviter justement les doublons.
Un tableau structuré sera généré pour recevoir les données qui seront classées par ordre croissant :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Set
Tableau =
Range
(
"TS_Eleves"
)
Dim
TS_Destination As
Range
' Suppression de l'éventuel ancien tableau (erreur générée si Range("Tableau_Noms") n’existe pas):
On
Error
Resume
Next
Set
TS_Destination =
Range
(
"Tableau_Noms"
)
Call
TS_SupprimerLeTableau
(
TS_Destination)
' Gestion des erreurs :
On
Error
GoTo
Gest_Err
Err
.Clear
' Création du tableau sans doublon :
Set
TS_Destination =
TS_CréerUnTableau
(
Plage:=
ThisWorkbook.Sheets
(
"Feuil2"
).Range
(
"A1"
), _
Titres:=
"Nom"
, _
Nom:=
"Tableau_Noms"
, _
Style:=
"*"
)
' Importation des données sans doublons
Call
TS_ImporterDonnées
(
TS_Destination, Tableau, TS_MAJ_Ou_Ajout, True
, "Nom"
)
' Tri de la colonne :
Call
TS_TrierUneColonne
(
TS:=
TS_Destination, _
Colonne:=
"Nom"
, _
Méthode:=
xlSortOnValues, _
Ordre:=
xlAscending, _
EffacerAncienTri:=
True
)
' Gestion des erreurs :
Gest_Err
:
If
Err
.Number
<>
0
Then
MsgBox
Err
.Number
&
" : "
&
Err
.Description
, vbCritical
, Err
.Source
End
Sub
'------------------------------------------------------------------------------------------------
Ce qui donne :
VI-C. TS_ExporterEnFichier▲
La fonction TS_ExporterEnFichier exporte un tableau structuré du classeur actif en fichier image JPG ou BMP, en fichier au format « Portable Document Format » PDF, en fichier texte au format CSV, ou en fichier Excel.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- FormatFichier : le format de fichier à générer suivant l’énumération Enum_ExportationTS
- TS_XLSX : fichier Excel,
- TS_CSV : fichier texte au format CSV avec le séparateur point-virgule (les lignes masquées ne sont pas reprises),
- TS_BMP : fichier image au format BMP,
- TS_JPG : fichier image au format JPG,
- TS_PDF : fichier au format PDF ; - OuvrirFichier : si
True
alors ouvre le fichier généré.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple pour exporter le tableau structuré nommé « TS_Eleves » en fichier PDF et l’ouvrir :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
If
TS_ExporterEnFichier
(
Range
(
"TS_Eleves"
), TS_PDF, "P:\Fichier\Tableau_Eleves.pdf"
, True
) =
False
Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbCritical
, "Erreur de conversion en PDF"
End
If
'------------------------------------------------------------------------------------------------
Vous trouverez en annexe 2 un code VBA pour fusionner deux fichiers PDF si vous disposez de l’application « Adobe Acrobat Pro ».
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ExporterEnFichier
(
TS As
Range, _
FormatFichier As
Enum_ExportationTS, _
ByVal
FichierDest As
String
, _
OuvrirFichier As
Boolean
) As
Boolean
'------------------------------------------------------------------------------------------------
' Exporte un Tableau Structuré du classeur actif en fichier au format XLSX, CSV, BMP, JPG, PDF.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' FormatFichier : le format de fichier à générer, voir l'énumération Enum_ExportationTS
' TS_XLSX : fichier Excel.
' TS_CSV : fichier texte au format CSV, séparateur point-virgule (ne prend pas les lignes masquées).
' TS_BMP : fichier image au format BMP.
' TS_JPG : fichier image au format JPG.
' TS_PDF : fichier au format "Portable Document Format" PDF.
' FichierDest : le chemin destination (qui doit exister) et le nom du fichier à créer,
' si un fichier existait déjà il est remplacé.
' OuvrirFichier : Si VRAI alors ouvre le fichier généré.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim
Repertoire As
String
, Sh As
Worksheet
Dim
Filtre As
String
Dim
Tmp As
String
, FileNumber As
Long
, ol As
Range, oC As
Range
Dim
Anc_ScreenUpdating As
Boolean
Dim
Anc_Visible As
Integer
Dim
ObjPicture As
Object
Dim
Rng As
Range
On
Error
GoTo
Gest_Err
Err
.Clear
' Mémorise la feuille active:
Set
Sh =
ActiveSheet
' Force la mise à jour de l'écran:
Anc_ScreenUpdating =
Application.ScreenUpdating
Application.ScreenUpdating
=
True
' Sélection de la feuille et de la plage:
Anc_Visible =
Sheets
(
TS.Parent.Name
).Visible
Sheets
(
TS.Parent.Name
).Visible
=
True
Sheets
(
TS.Parent.Name
).Activate
Set
Rng =
TS.ListObject.Range
' Le fichier destination doit être renseigné:
If
FichierDest =
""
Then
Err
.Raise
vbObjectError
, , "Le fichier destination doit être renseigné."
' Le répertoire doit exister:
Repertoire =
Left
(
FichierDest, InStrRev
(
FichierDest, "\"
))
If
CreateObject
(
"Scripting.FileSystemObject"
).Folderexists
(
Repertoire) =
False
Then
_
Err
.Raise
vbObjectError
, , "Le dossier de destination "
&
Repertoire &
" n'est pas présent."
' Traitements suivant le type de fichier à générer:
Application.Cursor
=
xlWait
Select
Case
FormatFichier
Case
TS_CSV
' Contrôle la présence de l'extension et supprime le fichier existant:
If
UCase
(
Right
(
FichierDest, 4
)) <>
".CSV"
Then
FichierDest =
FichierDest &
".csv"
If
Dir
(
FichierDest) <>
""
Then
Kill FichierDest
' Ajustement des colonnes pour ne pas avoir de # quand elles sont trop petites:
TS.Cells.EntireColumn.AutoFit
' Création d'un fichier:
FileNumber =
FreeFile
Open FichierDest For
Output As
#FileNumber
' Boucle sur les lignes:
For
Each
ol In
Rng.Rows
' Boucle sur les cellules de la ligne:
Tmp =
""
' Si la ligne n'est pas masquée:
If
ol.Height
<>
0
Then
' Boucle sur les colonnes:
For
Each
oC In
ol.Cells
Tmp =
Tmp &
CStr
(
oC.Text
) &
";"
Next
' Ne pas prendre le dernier séparateur:
Tmp =
Left
(
Tmp, Len
(
Tmp) -
1
)
' Ecriture dans le fichier:
Print #FileNumber, Tmp
End
If
Next
Close #FileNumber
Case
TS_XLSX
' Contrôle la présence de l'extension et supprime le fichier existant:
If
UCase
(
Right
(
FichierDest, 5
)) <>
".XLSX"
Then
FichierDest =
FichierDest &
".xlsx"
If
Dir
(
FichierDest) <>
""
Then
Kill FichierDest
' Copie le Tableau Structuré:
TS.ListObject.Range.Copy
' Ouvre une instance Excel et un classeur:
Dim
AppXl As
Excel.Application
Set
AppXl =
CreateObject
(
"excel.application"
)
AppXl.Visible
=
False
AppXl.Workbooks.Add
' Y copie le Tableau Structuré en plage:
AppXl.ActiveSheet.Paste
' Converti la plage en Tableau Structuré:
Call
TS_ConvertirPlageEnTS
(
AppXl.ActiveSheet.Range
(
"A1"
), TS.ListObject.DisplayName
, TS.Parent.ListObjects
(
TS.ListObject.Name
).TableStyle
, xlYes)
AppXl.ActiveSheet.Range
(
"A1"
).Select
' Sauvegarde le fichier et ferme l'instance:
AppXl.ActiveWorkbook.SaveAs
FichierDest
AppXl.ActiveWorkbook.Close
Set
AppXl =
Nothing
Case
TS_PDF
' Contrôle la présence de l'extension et supprime le fichier existant:
If
UCase
(
Right
(
FichierDest, 4
)) <>
".PDF"
Then
FichierDest =
FichierDest &
".pdf"
If
Dir
(
FichierDest) <>
""
Then
Kill FichierDest
' Création d'un fichier au format PDF:
Rng.ExportAsFixedFormat
xlTypePDF, FichierDest
Case
TS_BMP, TS_JPG
' Contrôle la présence de l'extension et supprime le fichier existant:
If
FormatFichier =
TS_BMP Then
If
UCase
(
Right
(
FichierDest, 4
)) <>
".BMP"
Then
FichierDest =
FichierDest &
".bmp"
Filtre =
"BMP"
End
If
If
FormatFichier =
TS_JPG Then
If
UCase
(
Right
(
FichierDest, 4
)) <>
".JPG"
Then
FichierDest =
FichierDest &
".jpg"
Filtre =
"JPG"
End
If
If
Dir
(
FichierDest) <>
""
Then
Kill FichierDest
' Copie les cellules dans le Presse-papiers en tant qu'image:
Rng.CopyPicture
Appearance:=
xlScreen, Format:=
xlPicture
' Création d'un objet image (de petite taille mais elle sera ajustée):
Set
ObjPicture =
Rng.Parent.ChartObjects.Add
(
10
, 10
, 10
, 10
)
DoEvents
With
ObjPicture
.ShapeRange.Line.Visible
=
msoFalse ' Masque l'objet.
DoEvents
.Height
=
Rng.Height
' Ajuste la hauteur.
.Width
=
Rng.Width
' Ajuste la largeur.
DoEvents
.Chart.Paste
' Colle le presse-papiers
DoEvents
.Chart.Export
Filename:=
FichierDest, Filtername:=
Filtre ' Exporte l'image
.Delete
' Supprime l'objet.
End
With
Case
Else
Err
.Raise
vbObjectError
, , "Le type d'exportation demandé n'est pas géré."
End
Select
' Renvoie Vrai:
TS_ExporterEnFichier =
True
' Fin du traitement:
Gest_Err
:
Sh.Activate
Application.ScreenUpdating
=
Anc_ScreenUpdating
Sheets
(
TS.Parent.Name
).Visible
=
Anc_Visible
Application.Cursor
=
xlDefault
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ExporterEnFichier"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ExporterEnFichier"
End
If
Err
.Clear
' S'il faut ouvrir le fichier:
If
TS_ExporterEnFichier =
True
And
OuvrirFichier =
True
And
TS_Err_Number =
0
_
Then
Call
Shell
(
"Explorer.exe "
&
FichierDest, vbMaximizedFocus)
End
Function
'------------------------------------------------------------------------------------------------
VI-D. TS_EnregistrerDansAccess▲
La fonction TS_EnregistrerDansAccess enregistre un tableau structuré ou certaines de ses colonnes dans une base Access. Les éventuels enregistrements de la table préalablement créée ne sont pas effacés, les nouveaux enregistrements issus du tableau structuré y sont ajoutés. La fonction ne prend pas en charge les règles de gestion de la table Access, il conviendra donc de s'assurer que les données du tableau structuré sont cohérentes avec la table de destination pour ne pas générer une erreur d'importation dans Access.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- BaseAccess : le nom complet de la base Access (y compris son dossier) ;
- TableAccess : le nom de la table dans la base ;
- MotDePasse : éventuellement le mot de passe qui protège la base Access ;
- ListeChampsColonnes : la liste des couples sous forme d'un
Array
(c'est-à-dire entre guillemets et séparés par une virgule) des champs de la table et des colonnes du tableau structuré (voir exemple). S'il faut prendre une valeur fixe pour un champ et non pas la valeur de la colonne alors faire précéder le nom du champ par ">" (supérieur). Laissez vide pour prendre toutes les colonnes à l'identique des champs ; - VisibleUniquement : si
True
alors ne traite que les lignes visibles, siFalse
alors traite toutes les lignes même les masquées.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple d'utilisation :
Soit une base Access "P:\Test.accdb" avec une table "Table_1" qui contient les champs "A", "B" qu'il faut alimenter par les colonnes "Nom", "Prénom" du tableau structuré "TS_Eleves_1" pour toutes les lignes, même masquées :
Call
TS_EnregistrerDansAccess
(
Range
(
"TS_Eleves_1"
), "P:\Test.accdb"
, "Table_1"
, ""
, Array
(
"A"
, "Nom"
, "B"
, "Prénom"
), False
)
Si les champs de la table Access ont le même nom que les en-têtes du tableau structuré, il est possible de remplacer par :
Call
TS_EnregistrerDansAccess
(
Range
(
"TS_Eleves_1"
), "P:\Test.accdb"
, "Table_1"
, ""
, ""
, False
)
c'est-à-dire sans renseigner l'argument "ListeChampsColonnes".
Pour forcer une valeur fixe pour un champ et non pas la valeur de la cellule de la colonne, faire précéder le nom du champ par ">" (supérieur).
Exemple pour ajouter l'utilisateur en cours (obtenu par Application.UserName
) dans le champ "Qui" :
Call
TS_EnregistrerDansAccess
(
Range
(
"TS_Eleves"
), "P:\Test.accdb"
, "Table_1"
, ""
, Array
(
"Nom"
, "Nom"
, "Prénom"
, "Prénom"
, ">Qui"
, Application.UserName
), False
)
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_EnregistrerDansAccess
(
TS As
Range, _
BaseAccess As
String
, TableAccess As
String
, MotDePasse As
String
, _
ListeChampsColonnes As
Variant
, _
VisibleUniquement As
Boolean
) As
Boolean
'-----------------------------------------------------------------------------------------------
' Enregistre un tableau structuré (ou certaines de ses colonnes) dans une base Access.
'-----------------------------------------------------------------------------------------------
' TS : le tableau structuré.
' BaseAccess : le nom complet de la base Access.
' TableAccess : le nom de la table dans la base.
' MotDePasse : éventuellement le mot de passe qui protège la base Access.
' ListeChampsColonnes : la liste des couples sous forme d'un array (c'est-à-dire entre guillemets et séparés par
' une virgule) des champs de la table et des colonnes du tableau structuré (voir exemple).
' S'il faut prendre une valeur fixe pour un champ et non pas la valeur de la colonne alors
' faire précéder le nom du champ par ">" (supérieur).
' Laissez vide pour prendre toutes les colonnes à l'identique des champs.
' VisibleUniquement : Si VRAI ne traite que les lignes visibles.
'-----------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'-----------------------------------------------------------------------------------------------
' Exemple d'utilisation :
' Soit une base Access "P:\Test.accdb" avec une table "Table_1" qui contient les champs "A", "B" qu'il faut alimenter par
' les colonnes "Nom", "Prénom" d'un du tableau structuré "TS_Eleves" pour toutes les lignes, même masquées.
' Call TS_EnregistrerDansAccess(Range("TS_Eleves"), "P:\Test.accdb", "Table_1", "", Array("A", "Nom", "B", "Prénom"), False)
' Si les champs de la table Access ont le même nom que les en-têtes du tableau structuré, il est possible de remplacer
' Call TS_EnregistrerDansAccess(Range("TS_Eleves"), "P:\Test.accdb", "Table_1", "", Array("Nom", "Nom", "Prénom", "Prénom"), False)
' par Call TS_EnregistrerDansAccess(Range("TS_Eleves"), "P:\Test.accdb", "Table_1", "", "", False) c'est-à-dire sans renseigner
' l'argument "ListeChampsColonnes".
' Pour forcer une valeur fixe pour un champ et non pas la valeur de la cellule de la colonne, faire précéder le nom du champ
' par ">" (supérieur). Exemple pour ajouter l'utilisateur en cours dans le champ "Qui" :
' Call TS_EnregistrerDansAccess(Range("TS_Eleves"), "P:\Test.accdb", "Table_1", "", Array("Nom", "Nom", "Prénom", "Prénom", ">Qui", Application UserName), False)
'-----------------------------------------------------------------------------------------------
' La liaison anticipée nécessite d'installer la référence : Microsoft ActiveX Data Objects 6.0 Library
' La liaison tardive permet de ne pas référencer la bibliothèque ADO.
' L’instanciation d’objets à l’aide de la liaison tardive est généralement plus lente
' que l’utilisation de la liaison anticipée.
' Ici la liaison tardive a été adoptée uniquement pour vous éviter d'installer manuellement une
' référence et donc simplifier la portabilité du code.
' Les remarques ci-dessous indiquent comment adapter le code pour une liaison anticipée.
'------------------------------------------------------------------------------------------------
Dim
y As
Long
Dim
i As
Integer
Dim
x As
Integer
Dim
Anc_Cursor As
Long
Dim
Anc_StatusBar As
Variant
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' S'il faut prendre toutes les colonnes du TS pour alimenter les champs de la table Access
' qui ont exactement le même nom que les en-têtes des colonnes:
If
IsArray
(
ListeChampsColonnes) =
False
Then
i =
TS_Nombre_Colonnes
(
TS) *
2
ReDim
ListeChampsColonnes
(
0
To
i -
1
)
For
i =
0
To
UBound
(
ListeChampsColonnes) Step
2
x =
x +
1
ListeChampsColonnes
(
i) =
TS.ListObject.HeaderRowRange
(
x).Value
ListeChampsColonnes
(
i +
1
) =
TS.ListObject.HeaderRowRange
(
x).Value
Next
i
End
If
' Mémorise la présentation:
Anc_Cursor =
Application.Cursor
Application.Cursor
=
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
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_EnregistrerDansAccess"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_EnregistrerDansAccess"
End
If
Err
.Clear
End
Function
'-----------------------------------------------------------------------------------------------
Private
Function
TS_Cnn_Initialise
(
StrBaseSource As
String
, MotDePasse As
String
) As
Boolean
'-----------------------------------------------------------------------------------------------
' Ouvre une connexion avec la méthode ADO sur une base ACCESS.
' StrBaseSource = Base concernée (chemin complet + nom avec l'extension).
' MotDePasse = le mot de passe pour la connexion à la base.
' Renvoie : VRAI si connexion réussie ou FAUX si erreur.
'-----------------------------------------------------------------------------------------------
' Gestion des erreurs:
Err
.Clear
On
Error
GoTo
Gest_Err
' Si le chemin StrBaseSource n'est pas valide alors force une erreur personnalisée:
If
Dir
(
StrBaseSource) =
""
Then
Err
.Raise
vbObjectError
, , "La base """
&
StrBaseSource &
""" n'a pas été trouvée."
End
If
' Paramètres de connexion:
Set
Cnn_TS =
CreateObject
(
"ADODB.Connection"
) ' => New ADODB.Connection
Cnn_TS.CommandTimeout
=
30
Cnn_TS.CursorLocation
=
2
' => adUseServer
Application.StatusBar
=
"Demande de connexion..."
: DoEvents
' Détermine le fournisseur pour les bases .accdb, ou .mdb:
If
MotDePasse =
""
Then
' Sans mot de passe:
Cnn_TS.Open
"Provider= "
&
Provider_ACCDB &
";"
_
&
"Data Source="
&
StrBaseSource &
";"
_
, "Admin"
, ""
, 16
' => adAsyncConnect
Else
' Avec mot de passe (<2010 ou "Paramètres du client/Avancé/Utiliser le chiffrement hérité)
Cnn_TS.Open
"Provider= "
&
Provider_ACCDB &
";"
_
&
"Data Source="
&
StrBaseSource &
";"
_
&
"Jet OLEDB:Database Password="
&
MotDePasse &
";"
End
If
' Vérifie la connexion:
While
(
Cnn_TS.State
=
2
): DoEvents: Wend
' => adStateConnecting
' Retourne VRAI si tout va bien (ou FAUX si une Erreur est détectée):
On
Error
Resume
Next
If
Cnn_TS.State
=
1
Then
' => adStateOpen
TS_Cnn_Initialise =
True
' Connexion Ok
End
If
' Gestion des erreurs:
Gest_Err
:
' Désactiver la connexion:
If
Cnn_TS Is
Nothing
=
False
Then
If
Cnn_TS.State
=
1
Then
Cnn_TS.Close
' => adStateOpen
End
If
Application.StatusBar
=
""
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VI-E. TS_ImporterDepuisAccess▲
La fonction TS_ImporterDepuisAccess recopie les enregistrements d'une table ou d'une requête d'une base Access dans un tableau structuré.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré (s'il n'y pas assez de colonnes dans le tableau pour recevoir les données importées elles seront ajoutées automatiquement) ;
- BaseAccess : le nom complet de la base Access (y compris son dossier) ;
- MotDePasse : éventuellement le mot de passe qui protège la base Access ;
- ListeDesChamps : la liste des champs à récupérer, séparés par une virgule. Mettre les champs entre des crochets ouverts "[" et fermés "]" s'ils contiennent des espaces. Laissez à vide pour reprendre tous les champs ;
- SQLWhere : la requête d'instruction en langage SQL permettant d'identifier la sélection (sans le mot clé WHERE). Si SQLWhere vaut "" alors toute la table est sélectionnée ;
- Méthode : indique si les données importées doivent remplacer celles existantes dans le tableau structuré ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
La fonction renvoie : le nombre de lignes importées ou -1 en cas d'erreur.
Exemple d'utilisation pour importer dans le tableau structuré « TS_Eleves » tous les champs de la table des élèves « Eleves » de la base Access « Ecole.accdb » dont la note est supérieure à 10 (et effacer les éventuelles données antérieures) :
Call
TS_ImporterDepuisAccess
(
Range
(
"TS_Eleves"
), "C:\Access\Ecole.accdb"
, "Eleves"
, ""
, ""
, "Note>10"
, TS_RemplacerDonnées)
Si besoin vous trouverez en Annexe 1 plus d'informations sur le langage SQL.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ImporterDepuisAccess
(
TS As
Range, _
BaseAccess As
String
, TableAccess As
String
, MotDePasse As
String
, _
ByVal
ListeDesChamps As
Variant
, ByVal
SQLWhere As
String
, _
ByVal
Méthode As
Enum_CopierDonnées) As
Long
'-----------------------------------------------------------------------------------------------
' Lit les enregistrements d'une table ou d'une requête d'une base Access.
' Les champs peuvent être définis dans ListeDesChamps ou tous sont repris si "" est indiqué.
' Les données sont recopiées dans le tableau structuré en remplacement des données existantes ou ajoutées.
'-----------------------------------------------------------------------------------------------
' TS : le tableau structuré où importer les données issues d'Access.
' S'il n'y pas assez de colonnes dans le tableau elles sont ajoutées.
' BaseAccess : le nom complet de la base Access.
' TableAccess : le nom de la table dans la base.
' 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
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ImporterDepuisAccess"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ImporterDepuisAccess"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VI-F. TS_RequeteBaseAccess▲
La fonction TS_RequeteBaseAccess permet de faire des requêtes sur les enregistrements d'une base Access.
Ses arguments sont :
- BaseAccess : le nom complet de la base Access (y compris son dossier) ;
- MotDePasse : éventuellement le mot de passe qui protège la base Access ;
- StrSQL : la requête d'instruction en langage SQL.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Exemple d'utilisation pour supprimer tous les enregistrements de table "T_Notes" dans la base Eleves (à utiliser avant d'y copier de nouveaux enregistrements en remplacement des anciens, voir le chapitre précédent) :
Call
TS_RequeteBaseAccess
(
"P:\Eleves.accdb"
), ""
, "DELETE * FROM [T_Notes]"
)
Si besoin vous trouverez en Annexe 1 plus d'informations sur le langage SQL.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_RequeteBaseAccess
(
BaseAccess As
String
, MotDePasse As
String
, _
StrSQL As
String
) As
Boolean
'-----------------------------------------------------------------------------------------------
' Fait une requête sur une table d'une base Access.
'-----------------------------------------------------------------------------------------------
' BaseAccess : le nom complet de la base Access.
' MotDePasse : éventuellement le mot de passe qui protège la base Access.
' StrSQL : Requête d'instruction.
'-----------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'-----------------------------------------------------------------------------------------------
' Exemple pour supprimer les enregistrements de la table "T_Notes" dans la base Eleves:
' Call TS_RequeteBaseAccess("P:\Eleves.accdb"), "", "DELETE * FROM [T_Notes]")
'-----------------------------------------------------------------------------------------------
' Mémorise la configuration:
Dim
Anc_Screen As
Boolean
Dim
Anc_Cursor As
Long
Dim
Anc_StatusBar As
Variant
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Mémorise la présentation:
Anc_Cursor =
Application.Cursor
Application.Cursor
=
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: "
&
StrSQL, 99
)
Cnn_TS.Execute
StrSQL
' Fermeture de la base:
Cnn_TS.Close
' Renvoie Vrai:
TS_RequeteBaseAccess =
True
' Fin du traitement:
Gest_Err
:
Set
Cnn_TS =
Nothing
Application.StatusBar
=
Anc_StatusBar
Application.Cursor
=
Anc_Cursor
Application.ScreenUpdating
=
Anc_Screen
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_RequeteBaseAccess"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_RequeteBaseAccess"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VI-G. TS_CopierUneColonne▲
La fonction TS_CopierUneColonne copie une colonne d'un tableau structuré dans un autre tableau structuré.
Ses arguments sont :
- TS_Source : la plage (de type Range) du tableau structuré source où se trouve la colonne à copier ;
- Colonne_Source : le nom ou le numéro de la colonne à copier. Si 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 première 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 » :
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_CopierUneColonne
(
TS_Source As
Range, ByVal
Colonne_Source As
Variant
, _
TS_Dest As
Range, ByVal
Colonne_Dest As
Variant
, ByVal
Ligne_Dest As
Long
, _
Optional
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 première 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
' Renvoie Vrai:
TS_CopierUneColonne =
True
' Fin du traitement:
Gest_Err
:
' Restaure la configuration:
Sheets
(
TS_Dest.Parent.Name
).Visible
=
Anc_Visible
Sheets
(
Anc_Feuille).Activate
Application.ScreenUpdating
=
Anc_Screen
If
Err
.Number
=
1004
Then
Err
.Clear
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_CopierUneColonne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_CopierUneColonne"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VI-H. TS_CopierValeurColonne▲
La fonction TS_CopierValeurColonne copie en valeur une colonne d'un tableau structuré dans un autre tableau structuré, ou dans le même tableau, voire dans la même colonne ce qui équivaut dans ce cas à un copier/coller en valeur.
Les tableaux n'ont pas besoin d'être sur la feuille active ni sur la même feuille.
Ses arguments sont :
- TS_Source : la plage (de type Range) du tableau structuré source où se trouve la colonne à copier ;
- Colonne_Source : le nom ou le numéro de la colonne à copier. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée ;
- TS_Dest : la plage (de type Range) du tableau structuré destination où il faut copier la colonne ;
- Colonne_Dest : le nom ou le numéro de la colonne où copier les données. Si ce nom est vide ou contient zéro, alors la dernière colonne du tableau est traitée ;
- Méthode : indique si les données à copier doivent remplacer celles existantes dans le tableau structuré ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes ; - VisibleUniquement : Si
True
seules les données visibles sont traitées, siFalse
les données masquées sont prises en compte également.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Remarque : contrairement à la fonction TS_CopierUneColonne, la fonction TS_CopierValeurColonne ne copie que les valeurs, mais elle se révèle beaucoup plus rapide, c'est pourquoi je la préfère.
Exemple pour sélectionner les élèves admis du tableau « TS_Eleves_1 » et recopier les colonnes « Nom » et « Prénom » dans le tableau « TS_Eleves_2 » :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Dim
Destination As
Range
Set
Tableau =
Range
(
"TS_Eleves_1"
)
Set
Destination =
Range
(
"TS_Eleves_2"
)
' Filtre les Admis = OK du tableau source:
Call
TS_Filtres_Effacer
(
Tableau)
Call
TS_Filtres_Poser
(
Tableau, "Admis"
, "Ok"
)
' Effacer les lignes du tableau destination:
Call
TS_EffacerToutesLignes
(
Destination)
Call
TS_SupprimerPlusieursLignes
(
Destination, 2
, 0
)
' Recopie les élèves dans le tableau destination:
Call
TS_CopierValeurColonne
(
Tableau, "Nom"
, Destination, "Nom"
, TS_RemplacerDonnées, True
)
Call
TS_CopierValeurColonne
(
Tableau, "Prénom"
, Destination, "Prénom"
, TS_RemplacerDonnées, True
)
' Efface le filtre sur Admis:
Call
TS_Filtres_Effacer
(
Tableau)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_CopierValeurColonne
(
TS_Source As
Range, ByVal
Colonne_Source As
Variant
, _
TS_Dest As
Range, ByVal
Colonne_Dest As
Variant
, _
Méthode As
Enum_CopierDonnées, _
VisibleUniquement As
Boolean
) As
Boolean
'------------------------------------------------------------------------------------------------------
' Copie en valeur une colonne d'un tableau structuré dans un autre tableau structuré (ou dans le même).
'------------------------------------------------------------------------------------------------------
' TS_Source : le tableau structuré source où se trouve la colonne à copier.
' Colonne_Source : la colonne à copier (son nom ou son numéro).
' TS_Dest : le tableau structuré destination où il faut copier la colonne.
' Colonne_Dest : la colonne où copier les données (son nom ou son numéro).
' Méthode : énumération Enum_CopierDonnées =
' TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
' TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
' VisibleUniquement : Si VRAI ne traite que les lignes visibles.
'------------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim
Copie As
Variant
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne source et vérifie sa cohérence (ou -1 si erreur):
Colonne_Source =
TS_IndexColonne
(
TS_Source, Colonne_Source)
If
Colonne_Source =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Retrouve le numéro de la colonne destination et vérifie sa cohérence (ou -1 si erreur):
Colonne_Dest =
TS_IndexColonne
(
TS_Dest, Colonne_Dest)
If
Colonne_Dest =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Copie les données source:
Select
Case
VisibleUniquement
Case
True
:
Dim
r As
Range, i As
Long
, c As
Range
Set
r =
TS_Source.ListObject.ListColumns
(
Colonne_Source).DataBodyRange.SpecialCells
(
xlCellTypeVisible)
ReDim
Copie
(
1
To
r.Count
, 1
To
1
)
For
Each
c In
r
i =
i +
1
Copie
(
i, 1
) =
c.Value
Next
c
Case
False
:
Copie =
TS_Source.ListObject.ListColumns
(
Colonne_Source).DataBodyRange.Value
End
Select
' 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
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_CopierValeurColonne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_CopierValeurColonne"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VI-I. TS_CopierUneLigne▲
La fonction TS_CopierUneLigne copie une ligne (en valeur ou en formule) d'un tableau structuré dans un autre tableau structuré, ou dans le même tableau.
Les tableaux n'ont pas besoin d'être sur la feuille active ni sur la même feuille.
Ses arguments sont :
- TS_Source : la plage (de type Range) du tableau structuré source où se trouve la ligne à copier ;
- Ligne_Source : le numéro de la ligne à copier. Si zéro alors la dernière ligne du tableau est traitée ;
- TS_Dest : la plage (de type Range) du tableau structuré destination où il faut copier la ligne ;
- Ligne_Dest : le nom de la ligne où copier les données. Si zéro alors la dernière ligne du tableau est traitée ;
- ValeursOuFormules : énumération Enum_ValeursOuFormules pour indiquer s'il faut copier les valeurs ou les formules :
- TS_Valeurs : copie des valeurs,
- TS_Formules : copie des formules.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Remarque: Si le tableau destination à moins de colonnes que la source, la copie se limite aux colonnes existantes. S'il en a plus, les colonnes supplémentaires sont effacées.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_CopierUneLigne
(
TS_Source As
Range, ByVal
Ligne_Source As
Long
, _
TS_Dest As
Range, ByVal
Ligne_Dest As
Long
, _
Optional
ValeursOuFormules As
Enum_ValeursOuFormules =
TS_Valeurs) As
Boolean
'------------------------------------------------------------------------------------------------------
' Copie une ligne d'un tableau structuré dans un autre tableau structuré.
'------------------------------------------------------------------------------------------------------
' TS_Source : le tableau structuré source où se trouve la ligne à copier.
' Ligne_Source : le numéro de la ligne à copier.
' TS_Dest : le tableau structuré destination où il faut copier la ligne.
' Ligne_Dest : ligne où recopier la ligne, par exemple 1 pour copier à la première ligne du tableau,
' ou 0 pour la dernière ligne du tableau.
' ValeursOuFormules : énumération Enum_ValeursOuFormules =
' TS_Valeurs : en valeurs (par défaut).
' TS_Formules : en formules (les en-têtes doivent être les mêmes dans les deux tableaux).
'------------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Remarque: Si le tableau destination à moins de colonnes que la source, la copie se limite aux colonnes
' existantes. S'il en a plus, les colonnes supplémentaires sont effacées.
'------------------------------------------------------------------------------------------------------
Dim
x As
Integer
, xx As
Integer
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Contrôle la cohérence de la ligne source passée en argument:
Ligne_Source =
TS_IndexLigne
(
TS_Source, Ligne_Source)
If
Ligne_Source =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Contrôle la cohérence de la ligne destination passée en argument:
Ligne_Dest =
TS_IndexLigne
(
TS_Dest, Ligne_Dest)
If
Ligne_Dest =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Efface les éventuelles données dans la destination:
TS_Dest.ListObject.DataBodyRange.Rows
(
Ligne_Dest).Clear
' Copie la ligne source:
xx =
TS_Nombre_Colonnes
(
TS_Source)
If
xx >
TS_Nombre_Colonnes
(
TS_Dest) Then
xx =
TS_Nombre_Colonnes
(
TS_Dest)
For
x =
1
To
xx
Select
Case
ValeursOuFormules
Case
TS_Valeurs
TS_Dest.ListObject.DataBodyRange
(
Ligne_Dest, x).Value
=
_
TS_Source.ListObject.DataBodyRange
(
Ligne_Source, x).Value
Case
TS_Formules
TS_Dest.ListObject.DataBodyRange
(
Ligne_Dest, x).Formula
=
_
TS_Source.ListObject.DataBodyRange
(
Ligne_Source, x).Formula
End
Select
Next
x
' Renvoie Vrai:
TS_CopierUneLigne =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_CopierUneLigne"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_CopierUneLigne"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VI-J. TS_CopierUnTableau▲
La fonction TS_CopierUnTableau copie l'intégralité d'un tableau structuré (y compris les colonnes masquées) dans un autre tableau structuré. Les données copiées sont soit les valeurs soit les formules.
La fonction gère aussi une source issue d'une plage mémorisée dans une variable (par la fonction TS_MémoriseTableau) ou d'un jeu d'enregistrements pour la copier en valeur dans un tableau structuré.
Ses arguments sont :
- TS_Source : la plage (de type Range) du tableau structuré source, ou des données mémorisées dans une variable ou un jeu d'enregistrements ;
- TS_Dest : la plage (de type Range) du tableau structuré destination ;
- Méthode : énumération Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes ; - ValeursOuFormules : énumération Enum_ValeursOuFormules :
- TS_Valeurs : en valeurs (par défaut),
- TS_Formules : en formules (les en-têtes doivent être les mêmes dans les deux tableaux).
La fonction renvoie : le nombre de lignes ajoutées ou -1 si erreur.
Remarques :
- Pour copier les formules avec TS_Formules les en-têtes doivent être les mêmes dans les deux tableaux et/ou les formules doivent être cohérentes avec le tableau de destination.
- Si le tableau source à plus de colonnes que le tableau destination : les colonnes en surplus sont ignorées.
- Si le tableau source à moins de colonnes que le tableau destination : les colonnes manquantes sont vides.
Exemple pour copier en valeur les données du tableau « TS_Eleves_1 » dans le tableau « TS_Eleves_2 » (qui volontairement ne contient que trois colonnes):
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
Tableau As
Range
Dim
Destination As
Range
Set
Tableau =
Range
(
"TS_Eleves_1"
)
Set
Destination =
Range
(
"TS_Eleves_2"
)
Call
TS_CopierUnTableau
(
Tableau, Destination, TS_RemplacerDonnées, TS_Valeurs)
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_CopierUnTableau
(
TS_Source As
Variant
, TS_Dest As
Range, _
Méthode As
Enum_CopierDonnées, _
Optional
ValeursOuFormules As
Enum_ValeursOuFormules =
TS_Valeurs) As
Long
'------------------------------------------------------------------------------------------------------
' Copie les données d'un tableau structuré (ou aussi d'une mémoire ou d'un jeu d'enregistrements) dans
' un autre tableau structuré.
'------------------------------------------------------------------------------------------------------
' TS_Source : le tableau structuré source, une mémoire, un jeu d'enregistrements.
' TS_Dest : le tableau structuré destination.
' Méthode : énumération Enum_CopierDonnées =
' TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
' TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
' ValeursOuFormules : énumération Enum_ValeursOuFormules =
' TS_Valeurs : en valeurs (par défaut).
' TS_Formules : en formules (les en-têtes doivent être les mêmes dans les deux tableaux).
'------------------------------------------------------------------------------------------------------
' Renvoie : le nombre de lignes ajoutées ou -1 si erreur.
'------------------------------------------------------------------------------------------------------
' Remarques :
' - TS_Source : peut être un tableau d'un autre classeur ouvert,
' exemple : Workbooks("Classeur1.xlsm").Sheets("Feuil1").Range("T_1")
' peut être un variant contenant les données du tableau,
' exemple : Données = TS_MémoriseTableau(Workbooks("Classeur1.xlsm").Sheets("Feuil1").Range("T_1"), TS_Valeurs)
' Call TS_CopierUnTableau(Données, Range("TS_Importation"), TS_RemplacerDonnées, TS_Valeurs)
' peut être un jeu d'enregistrements.
' - Pour copier les formules avec TS_Formules les en-têtes doivent être les mêmes dans les deux tableaux
' et/ou les formules doivent être cohérentes avec le tableau de destination.
' - Si le tableau source à plus de colonnes que le tableau destination : les colonnes en surplus sont ignorées.
' - Si le tableau source à moins de colonnes que le tableau destination : les colonnes manquantes sont vides.
'------------------------------------------------------------------------------------------------------
Dim
Copie As
Variant
Dim
NbOrigine As
Long
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Par défaut renvoie -1:
TS_CopierUnTableau =
-
1
' Mémorise les données de la source suivant son type:
Select
Case
TypeName
(
TS_Source)
Case
"Range"
' Tableau Structuté
Copie =
TS_MémoriseTableau
(
TS_Source, ValeursOuFormules)
Case
"Recordset"
' Jeu d'enregistrement
Dim
y As
Long
, x As
Integer
' S'il est vide alors déclencher une erreur pour sortir du traitement:
If
TS_Source.RecordCount
=
0
Then
Err
.Raise
91
' Dimensionne la mémoire qui va contenir les données du jeu d'enregistrements:
ReDim
Copie
(
1
To
TS_Source.RecordCount
, 1
To
TS_Source.Fields.Count
)
' Se place sur le 1° enregistrement (facultatif):
TS_Source.MoveFirst
' Boucle sur jeu d'enregistrements pour mémoriser les données:
For
y =
1
To
TS_Source.RecordCount
For
x =
1
To
TS_Source.Fields.Count
Copie
(
y, x) =
TS_Source.Fields
(
x -
1
).Value
If
IsNumeric
(
Copie
(
y, x)) =
True
Then
If
Len
(
Copie
(
y, x)) >
15
Then
Copie
(
y, x) =
"'"
&
Copie
(
y, x)
End
If
Next
x
TS_Source.MoveNext
Next
y
Case
Else
' Autres cas
Copie =
TS_Source
End
Select
' S'il y a des données:
If
IsNull
(
Copie) =
False
Then
' Ajuste à la taille du tableau destination:
ReDim
Preserve
Copie
(
1
To
UBound
(
Copie), 1
To
TS_Nombre_Colonnes
(
TS_Dest))
' Suivant s'il faut faire un remplacement des données ou un ajout aux données existantes:
Select
Case
Méthode
Case
TS_RemplacerDonnées
Call
TS_Filtres_Effacer
(
TS_Dest)
Call
TS_EffacerToutesLignes
(
TS_Dest)
NbOrigine =
0
' Dimensionne le tableau destination pour accueillir les données:
TS_Dest.ListObject.Resize
Range
(
Cells
(
TS_Dest.Row
-
1
, TS_Dest.Column
), Cells
(
TS_Dest.Row
+
UBound
(
Copie) -
1
, TS_Dest.Column
+
TS_Dest.ListObject.ListColumns.Count
-
1
))
' S'il est vierge alors il faut l'initialiser:
If
TS_Dest.ListObject.ListRows.Count
=
0
Then
TS_Dest.ListObject.Resize
Range
(
Cells
(
TS_Dest.Row
-
1
, TS_Dest.Column
), Cells
(
TS_Dest.Row
+
1
, TS_Dest.Column
+
TS_Dest.ListObject.ListColumns.Count
-
1
))
TS_Dest.ListObject.DataBodyRange.Rows
(
2
).Delete
End
If
' 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
(
NbOrigine +
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
End
If
' Fin du traitement:
Gest_Err
:
If
Err
.Number
=
91
Then
Err
.Clear
' Pas d'enregistrements dans le jeu passé en argument.
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_CopierUnTableau"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_CopierUnTableau"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VI-K. 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 » :
'------------------------------------------------------------------------------------------------
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
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_MémoriseTableau
(
TS As
Variant
, Optional
ValeursOuFormules As
Enum_ValeursOuFormules =
TS_Valeurs) As
Variant
'------------------------------------------------------------------------------------------------------
' Mémorise les données d'un tableau structuré dans un variant à plusieurs dimensions.
' Voir l'exemple de la fonction TS_CopierUnTableau.
'------------------------------------------------------------------------------------------------------
' TS : le tableau structuré concerné.
' ValeursOuFormules : énumération Enum_ValeursOuFormules =
' TS_Valeurs : en valeurs (par défaut).
' TS_Formules : en formules.
'------------------------------------------------------------------------------------------------------
' 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
' Pour forcer le mode texte sur les nombres préfixés:
If
ValeursOuFormules =
TS_Valeurs Then
For
y =
1
To
UBound
(
Données)
For
x =
1
To
UBound
(
Données, 2
)
Données
(
y, x) =
TS.ListObject.DataBodyRange
(
y, x).PrefixCharacter
&
Données
(
y, x)
Next
x
Next
y
End
If
' Renvoie les données:
TS_MémoriseTableau =
Données
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_MémoriseTableau"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_MémoriseTableau"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VI-L. TS_ImporterDepuisClasseur▲
Comme son nom l’indique la fonction TS_ImporterDepuisClasseur importe, dans un tableau structuré existant, les données d’un autre classeur. Les données sources peuvent être contenues soit dans une plage Excel classique, soit dans un tableau structuré.
L’importation peut porter sur l’intégralité des colonnes source ou sur certaines seulement.
Le fichier source peut être fermé ou déjà ouvert, mais normalement vous utiliserez cette fonction sur des classeurs fermés car pour les classeurs ouverts d’autres fonctions sont déjà proposées dans le module « TS ».
Pour éviter que les macros se lancent à l'ouverture du classeur avec l'événement Workbook_Open
(
) nous les désactiverons en forçant le mode de sécurité par l'instruction Application.AutomationSecurity
=
msoAutomationSecurityForceDisable, puis nous les restaurerons avec le mode en cours préalablement mémorisé.
Ses arguments sont :
- Fichier_Source : le classeur Excel qui contient les sources (chemin complet + nom avec l'extension) ;
- MotDePasse : éventuellement le mot de passe pour ouvrir le fichier (vide si non nécessaire) ;
- Nom_Tableau_Source : soit le nom du tableau structuré qui contient les données source (pas un Range, voir exemple), soit le nom de la feuille entre crochets ouvert « [ » et fermé « ] » suivi d'un point d'exclamation « ! » (si la plage à un en-tête ou un dollar « $ » si la plage n’en a pas) et de la plage ou de la première cellule haut-gauche de la plage (voir exemple) ;
- TS_Dest : le tableau structuré destination (de type Range) situé dans le classeur contenant cette fonction ;
- Méthode : indique si les données importées doivent remplacer celles existantes dans le tableau structuré ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes. - ListeColonnes : (facultatif) le couple des noms des colonnes sources, noms (ou numéro) des colonnes destination, séparé par une virgule. Si vide alors les colonnes du tableau source sont copiées dans la destination sans ajout de colonnes supplémentaires si la destination n'a pas assez de colonnes.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Remarques sur la source Nom_Tableau_Source :
- si la source est un tableau structuré alors passez son nom, par exemple
"Tableau1"
et non pas un objet Range commeRange
(
"Tableau1"
) ; - si la source est une plage classique, passez le nom de la feuille et la plage, comme par exemple
"[Feuil1]!A1"
pour que la fonction étende automatiquement la plage, ou"[Feuil1]!A1:C99"
pour prendre une plage déterminé ; - la plage doit avoir un en-tête, si ce n'est pas le cas remplacez « ! » par « $ » ;
- si le tableau source à plus de colonnes que le tableau destination alors les colonnes en surplus sont ignorées ;
- si le tableau source à moins de colonnes que le tableau destination alors les colonnes manquantes sont vides.
Exemples d'appels de la fonction TS_ImporterDepuisClasseur pour importer des données du fichier « C:\Sources\Monfichier.xls » (qui n'a pas de mot de passe) et les coller en valeur dans le tableau structuré « TS_1 ».
Si vous utilisez Dim
TS As
Range : Set
TS=
Range
(
"TS_1"
) alors remplacez Range
(
"TS_1"
) par TS dans les exemples :
La source est une plage qui commence en « A1 » de la feuille « Feuil1 » et il faut remplacer les données existantes dans le tableau structuré destination « TS_1 » :TS_ImporterDepuisClasseur
(
"C:\Sources\Monfichier.xls"
, ""
, "[Feuil1]!A1"
, Range
(
"TS_1"
), TS_RemplacerDonnées)
Idem mais cette fois en ajoutant les données importées à celles existantes :TS_ImporterDepuisClasseur
(
"C:\Sources\Monfichier.xls"
, ""
, "[Feuil1]!A1"
, Range
(
"TS_1"
), TS_AjouterDonnées)
La source est aussi un tableau structuré nommé « TS_X » et il faut remplacer les données existantes :TS_ImporterDepuisClasseur
(
"C:\Sources\Monfichier.xls"
, ""
, "TS_X"
, Range
(
"TS_1"
), TS_RemplacerDonnées)
Idem mais ici il ne faut pas prendre toutes les colonnes mais seulement dans la source les colonnes « MATRICULE », « NOM », « PRENOM » que l'on place dans la destination en colonnes nommées « A », « B » et à la dernière colonne :TS_ImporterDepuisClasseur
(
"C:\Sources\Monfichier.xls"
, ""
, "TS_X"
, _
Range
(
"TS_1"
), TS_RemplacerDonnées, "MATRICULE"
, "A"
, "NOM"
, "B"
, "PRENOM"
, 0
)
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Function
TS_ImporterDepuisClasseur
(
ByVal
Fichier_Source As
String
, MotDePasse As
String
, _
ByVal
Nom_Tableau_Source As
String
, _
ByVal
TS_Dest As
Range, _
Méthode As
Enum_CopierDonnées, _
ParamArray ListeColonnes
(
) As
Variant
) As
Boolean
'------------------------------------------------------------------------------------------------------
' Copie en valeur les données d'un tableau, structuré ou non structuré, issues d'un classeur Excel
' (théoriquement fermé mais s'il est déjà ouvert dans la même cession il ne sera pas refermé) dans un
' tableau structuré (existant) du classeur contenant ce code.
' Le classeur est ouvert pour copier la source mais les macros sont désactivées pour ouvrir le fichier sans
' lancer l'événement "Workbook_Open".
'------------------------------------------------------------------------------------------------------
' Fichier_Source : le classeur Excel qui contient les sources (chemin complet + nom avec l'extension).
' MotDePasse : éventuellement le mot de passe pour ouvrir le fichier (vide si non nécessaire).
' Nom_Tableau_Source : soit le nom du Tableau Structuré qui contient les données source (pas un Range, voir exemple),
' soit le nom de la feuille entre crochets "[" et "]" suivi d'un point d'exclamation "!"
' et de la plage ou de la première cellule haut-gauche de la plage (voir exemple).
' TS_Dest : le Tableau Structuré destination (de type Range) situé sur le classeur contenant cette fonction.
' Méthode : énumération Enum_CopierDonnées =
' TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
' TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
' ListeColonnes : (facultatif) le couple des noms des colonnes sources, noms (ou numéro) des colonnes destination,
' séparé par une virgule. Si vide alors les colonnes du tableau source sont copiées dans la
' destination sans ajout de colonnes supplémentaires si la destination n'a pas assez de colonnes.
'------------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Remarques :
' - Nom_Tableau_Source : Si la source est un tableau structuré alors passez son nom, par exemple "Tableau1" et
' non pas un objet Range de type comme Range("Tableau1").
' Si la source est une plage classique, passez le nom de la feuille et la plage, comme par
' exemple "[Feuil1]!A1" pour que la fonction étende automatiquement la plage,
' ou "[Feuil1]!A1:C99" pour prendre une plage déterminée.
' La plage doit avoir un en-tête, si ce n'est pas le cas remplacez "!" par "$".
' - Si le tableau source a plus de colonnes que le tableau destination : les colonnes en surplus sont ignorées.
' - Si le tableau source a moins de colonnes que le tableau destination : les colonnes manquantes sont vides.
'------------------------------------------------------------------------------------------------------
' Exemples d'appels pour importer des données du fichier "C:\Sources\Monfichier.xls" (qui n'a pas de mot de passe)
' et les coller en valeur dans le tableau structuré "TS_1":
' Si vous utilisez Dim TS As Range : Set TS=Range("TS_1") alors remplacez Range("TS_1") par TS dans les exemples.
' - La source est une plage qui commence en "A1" de la feuille "Feuil1" et il faut remplacer les données existantes
' dans le tableau structuré destination "TS_1":
' TS_ImporterDepuisClasseur("C:\Sources\Monfichier.xls", "", "[Feuil1]!A1", Range("TS_1"), TS_RemplacerDonnées)
' - Idem mais cette fois en ajoutant les données importées à celles existantes:
' TS_ImporterDepuisClasseur("C:\Sources\Monfichier.xls", "", "[Feuil1]!A1", Range("TS_1"), TS_AjouterDonnées)
' - La source est aussi un tableau structuré nommé "TS_X" et il faut remplacer les données existantes:
' TS_ImporterDepuisClasseur("C:\Sources\Monfichier.xls", "", "TS_X", Range("TS_1"), TS_RemplacerDonnées)
' - Idem mais ici il ne faut pas prendre toutes les colonnes mais seulement dans la source les colonnes "MATRICULE",
' "NOM", "PRENOM" que l'on place dans la destination en colonnes nommées "A", "B" et à la dernière colonne:
' TS_ImporterDepuisClasseur("C:\Sources\Monfichier.xls", "", "TS_X", Range("TS_1"), TS_RemplacerDonnées, "MATRICULE", "A", "NOM", "B", "PRENOM", 0)
'------------------------------------------------------------------------------------------------------
Dim
Wk As
Workbook
Dim
TS_Source As
Range
Dim
AvecEntete As
XlYesNoGuess
Dim
i As
Long
Dim
Anc_ScreenUpdating As
Boolean
Dim
Classeurs As
String
, NomCourt As
String
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
Set
Wk =
Nothing
' Désactive l'affiche écran:
Anc_ScreenUpdating =
Application.ScreenUpdating
Application.ScreenUpdating
=
False
' Mémorise les classeurs ouverts:
For
i =
1
To
Workbooks.Count
Classeurs =
Classeurs &
";"
&
Workbooks
(
i).Name
&
";"
Next
i
' Ouvre le classeur source en lecture seule s'il n'est pas déjà ouvert:
NomCourt =
Mid
(
Fichier_Source, 1
+
InStrRev
(
Fichier_Source, "\"
))
If
InStr
(
1
, Classeurs, ";"
&
NomCourt &
";"
) =
0
Then
' Désactive les macros pour ouvrir le fichier sans lancer "Workbook_Open":
Dim
secAutomation As
MsoAutomationSecurity
secAutomation =
Application.AutomationSecurity
Application.AutomationSecurity
=
msoAutomationSecurityForceDisable
' Ouvre le fichier:
Set
Wk =
Workbooks.Open
(
Fichier_Source, False
, True
, , MotDePasse)
' Réactive les macros:
Application.AutomationSecurity
=
secAutomation
Else
' ou l'active s'il est ouvert:
Workbooks
(
NomCourt).Activate
End
If
' Supprime les crochets dans le nom du tableau source (pas besoin de ces crochets dans le traitement):
Nom_Tableau_Source =
Replace
(
Nom_Tableau_Source, "["
, ""
)
Nom_Tableau_Source =
Replace
(
Nom_Tableau_Source, "]"
, ""
)
' Par défaut la plage a un en-tête sauf si "$" est utilisé:
AvecEntete =
xlYes
If
InStr
(
1
, Nom_Tableau_Source, "$"
) >
0
Then
AvecEntete =
xlNo
' Remplace "$" par "!":
Nom_Tableau_Source =
Replace
(
Nom_Tableau_Source, "$"
, "!"
)
' Analyse ce nom pour trouver la partie feuille et la partie plage (si ce coupe a été passé en argument):
i =
InStr
(
1
, Nom_Tableau_Source, "!"
)
Select
Case
i
' Si la source est le nom d'une feuille et d'une plage:
Case
Is
>
0
Dim
Feuille As
String
, Plage As
String
Feuille =
Mid
(
Nom_Tableau_Source, 1
, i -
1
)
Plage =
Mid
(
Nom_Tableau_Source, i +
1
)
' Si la plage est connue alors la prendre:
If
InStr
(
1
, Plage, ":"
) >
0
Then
Set
TS_Source =
Sheets
(
Feuille).Range
(
Plage)
Else
' Sinon prendre la plage étendue automatiquement:
Set
TS_Source =
Sheets
(
Feuille).Range
(
Plage).CurrentRegion
End
If
' Transforme la source en Tableau Structuré:
TS_Source.Parent.ListObjects.Add
xlSrcRange, TS_Source, , AvecEntete
' Si la source est le nom d'un Tableau Structuré alors l'initialiser:
Case
Else
Set
TS_Source =
Range
(
Nom_Tableau_Source)
Call
TS_Filtres_Effacer
(
TS_Source)
End
Select
' Copie les colonnes du tableau du fichier source dans les colonnes du fichier destination
' sans ajouter d'autres colonnes si la destination n'a pas assez de colonnes:
Select
Case
IsMissing
(
ListeColonnes)
Case
True
If
TS_CopierUnTableau
(
TS_Source, TS_Dest, Méthode, TS_Valeurs) >=
0
Then
TS_ImporterDepuisClasseur =
True
Case
False
If
UBound
(
ListeColonnes) <>
0
Then
Dim
Copie As
Variant
, Colonne As
Integer
, Ligne As
Long
' Trouve la position de la dernière ligne:
Ligne =
TS_Dest.ListObject.ListRows.Count
+
1
' S'il faut remplacer les données alors forcer la dernière ligne à 1 et supprimer les autres lignes:
If
Méthode =
TS_RemplacerDonnées Then
Ligne =
1
Call
TS_SupprimerPlusieursLignes
(
TS_Dest, 2
, 0
)
End
If
' Copie la première colonne (depuis la dernière ligne):
Call
TS_CopierValeurColonne
(
TS_Source, ListeColonnes
(
0
), TS_Dest, ListeColonnes
(
1
), Méthode, False
)
' Copie les autres colonnes (depuis la dernière ligne):
For
i =
2
To
UBound
(
ListeColonnes) Step
2
' Retrouve le numéro de la colonne source et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS_Source, ListeColonnes
(
i))
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Copie toutes les données de la colonne du tableau source:
Copie =
TS_Source.ListObject.ListColumns
(
Colonne).DataBodyRange.Value
' Retrouve le numéro de la colonne destination et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS_Dest, ListeColonnes
(
i +
1
))
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Colle les données dans la colonne du tableau destination:
TS_Dest.Cells
(
Ligne, Colonne).Resize
(
UBound
(
Copie), 1
) =
Copie
Next
i
TS_ImporterDepuisClasseur =
True
Else
If
TS_CopierUnTableau
(
TS_Source, TS_Dest, Méthode, TS_Valeurs) >=
0
Then
TS_ImporterDepuisClasseur =
True
End
If
End
Select
' Fin du traitement:
Gest_Err
:
' Ferme le fichier sauf s'il était déjà ouvert avant cette fonction:
If
Not
Wk Is
Nothing
Then
If
InStr
(
1
, Classeurs, ";"
&
Wk.Name
&
";"
) =
0
Then
Wk.Saved
=
True
Wk.Close
False
End
If
End
If
' Restaure l'affichage d'origine:
Application.ScreenUpdating
=
Anc_ScreenUpdating
' Gestion des erreurs:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ImporterDepuisClasseur"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ImporterDepuisClasseur"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VI-M. TS_ImporterDepuisClasseurAvecSQL▲
La fonction TS_ImporterDepuisClasseurAvecSQL importe, dans un tableau structuré existant, les données d’un classeur qui est fermé et effectuant une requête SQL pour la sélection des données à importer.
Les données sources peuvent être contenues soit dans une plage Excel classique soit dans un tableau structuré.
Le fichier source peut être déjà ouvert, mais normalement vous utiliserez cette fonction sur des classeurs fermés car pour les classeurs ouverts d’autres fonctions sont déjà proposées dans le module « TS ».
Le tableau source doit obligatoirement avoir un en-tête avec des noms de champs uniques pour pouvoir exécuter une requête.
Le classeur n'est ouvert que s'il est protégé par mot de passe (pas d'autre façon de faire) ou si un tableau structuré est passé dans le nom du tableau source (afin de retrouver la feuille concernée), mais comme pour la fonction TS_ImporterDepuisClasseur les macros sont désactivées pour ouvrir le fichier sans lancer l'événement Workbook_Open.
Ses arguments sont :
- Fichier_Source : le classeur Excel qui contient les sources (chemin complet + nom avec l'extension) ;
- MotDePasseOuverture : éventuellement le mot de passe pour ouvrir le fichier (vide si non nécessaire) ;
- MotDePasseEcriture : éventuellement le mot de passe pour permettre les modifications dans le fichier (vide si non nécessaire) ;
- Nom_Tableau_Source : soit le nom du tableau structuré qui contient les données source (pas un Range, voir exemple), soit le nom de la feuille entre crochets ouvert « [ » et fermé « ] » (voir exemple) ;
- TS_Dest : le tableau structuré destination (de type Range) situé dans le classeur contenant cette fonction ;
- Méthode : indique si les données importées doivent remplacer celles existantes dans le tableau structuré ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes. - StrChamps : (facultatif) le nom des champs de la requête ou vide pour tout prendre ;
- StrSQL : (facultatif) la requête SQL.
La fonction renvoie : le nombre de lignes importées ou -1 si erreur.
Remarques sur la source Nom_Tableau_Source :
- si la source est un tableau structuré alors passez son nom, par exemple
"Tableau1"
et non pas un objet Range commeRange
(
"Tableau1"
) ; - si la source est une plage classique, passez le nom de la feuille et la plage, comme par exemple
"[Feuil1]"
pour un traitement sur la feuille nommée « Feuil1 » ; - si le tableau source à plus de colonnes que le tableau destination alors les colonnes en surplus sont ignorées ;
- si le tableau source à moins de colonnes que le tableau destination alors les colonnes manquantes sont vides.
Exemples d'appels de la fonction TS_ImporterDepuisClasseurAvecSQL pour importer des données du fichier « C:\Sources\Monfichier.xls » (qui n'a pas de mot de passe) et les coller en valeur dans le tableau structuré « TS_1 ».
Si vous utilisez Dim
TS As
Range : Set
TS=
Range
(
"TS_1"
) alors remplacez Range
(
"TS_1"
) par TS dans les exemples :
La source est une plage de la feuille « Feuil1 » et il faut remplacer les données existantes dans le tableau structuré destination « TS_1 » par une requête SQL qui regroupe les données sources de la colonne « Référence » et les classe par ordre croissant :Call
TS_ImporterDepuisClasseurAvecSQL
(
"C:\_Formation_VBA\Test.xlsm"
, "Mgx"
, "x"
, _
"[Feuil1]"
, Range
(
"TS_1"
), TS_RemplacerDonnées, _
"[Référence]"
, "GROUP BY [Référence] ORDER BY [Référence]"
)
Idem mais cette fois les données sources sont dans un tableau structuré nommé « Tableau1 » et il faut compter le nombre de fois que les groupes de « Référence » sont utilisés, et trier des plus utilisés aux moins utilisés :Call
TS_ImporterDepuisClasseurAvecSQL
(
"C:\_Formation_VBA\Test.xlsm"
, "Mgx"
, "x"
, _
"Tableau1"
, Range
(
"TS_1"
), TS_RemplacerDonnées, _
"[Référence], Count([Référence])"
, "GROUP BY [Référence] ORDER BY count([Référence]) DESC"
)
Ou tout simplement importer toutes les données où « Montant » est supérieur à 100 :Call
TS_ImporterDepuisClasseurAvecSQL
(
"C:\_Formation_VBA\Test.xlsm"
, "Mgx"
, "x"
, _
"Tableau1"
, Range
(
"TS_1"
), TS_RemplacerDonnées, _
""
, "WHERE [Montant] > 100"
)
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Function
TS_ImporterDepuisClasseurAvecSQL
(
ByVal
Fichier_Source As
String
, _
ByVal
MotDePasseOuverture As
String
, _
ByVal
MotDePasseEcriture As
String
, _
ByVal
Nom_Tableau_Source As
String
, _
ByVal
TS_Dest As
Range, _
ByVal
Méthode As
Enum_CopierDonnées, _
Optional
ByVal
StrChamps As
String
, _
Optional
ByVal
StrSQL As
String
=
""
) As
Long
'------------------------------------------------------------------------------------------------------
' Copie en valeur les données d'un tableau, structuré ou non structuré, issues d'un classeur
' Excel (théoriquement fermé) dans un tableau structuré (existant) du classeur contenant ce code,
' suivant une requête SQL. Si le classeur est déjà ouvert il n'est pas refermé à la fin du traitement,
' mais dans ce cas il ne doit pas être en lecture seule.
' Le tableau source doit obligatoirement avoir un en-tête avec des noms de champs uniques pour pouvoir
' exécuter une requête.
' Le classeur n'est ouvert que s'il est protégé par mot de passe (pas d'autre façon de faire) ou si un tableau
' structuré est passé dans le nom du tableau source (afin de retrouver la feuille concernée), mais les macros
' sont désactivées pour ouvrir le fichier sans lancer l'événement "Workbook_Open".
'------------------------------------------------------------------------------------------------------
' Fichier_Source : le classeur Excel qui contient les sources (chemin complet + nom avec l'extension).
' MotDePasseOuverture : éventuellement le mot de passe pour ouvrir le fichier (vide si non nécessaire).
' MotDePasseEcriture : éventuellement le mot de passe pour modifier le fichier (vide si non nécessaire).
' Nom_Tableau_Source : soit le nom du tableau structuré qui contient les données source (pas un Range,
' voir exemple) soit le nom de la feuille entre crochets "[" et "]" (voir exemple).
' TS_Dest : le tableau structuré destination (de type Range) situé sur le classeur contenant cette fonction.
' Méthode : énumération Enum_CopierDonnées =
' TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
' TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
' StrChamps : (facultatif) la liste des champs de la requête (ou tous les champs si vide ou non renseigné).
' StrSQL : (facultatif) la requête SQL.
'------------------------------------------------------------------------------------------------------
' Renvoie : le nombre de lignes importées ou -1 si erreur.
'------------------------------------------------------------------------------------------------------
' Remarques :
' - si la source est un tableau structuré alors passez son nom, par exemple "Tableau1" et
' non pas un objet Range comme Range("Tableau1") dans l'argument "Nom_Tableau_Source".
' - Si la source est une plage classique, passez le nom de la feuille sans la plage, comme par
' exemple "[Feuil1]" pour un traitement sur la feuille nommée "Feuil1".
' - La plage doit obligatoirement avoir un en-tête avec des noms de champs uniques pour exécuter une requête.
' - Si le tableau source a plus de colonnes que le tableau destination : les colonnes en surplus sont ignorées.
' - Si le tableau source a moins de colonnes que le tableau destination : les colonnes manquantes sont vides.
'------------------------------------------------------------------------------------------------------
Dim
Wk As
Workbook
Dim
Cnn As
Variant
, Rs As
Variant
Dim
Enr As
Variant
Dim
i As
Long
, y As
Long
, x As
Integer
Dim
Classeurs As
String
, NomCourt As
String
Dim
ErreurFeuillle As
String
Dim
Anc_ScreenUpdating As
Boolean
Dim
Anc_Cursor As
Long
Dim
Anc_Attributes As
Long
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
Set
Wk =
Nothing
TS_ImporterDepuisClasseurAvecSQL =
-
1
' Désactive l'affichage de l'écran:
Anc_Cursor =
Application.Cursor
Application.Cursor
=
xlWait
Anc_ScreenUpdating =
Application.ScreenUpdating
Application.ScreenUpdating
=
False
' Création d'un objet FileSystemObject:
Dim
ObjFSO As
Object, ObjFile As
Object
Set
ObjFile =
Nothing
Set
ObjFSO =
CreateObject
(
"Scripting.FileSystemObject"
)
' Le fichier ne doit pas être en lecture seule pour pouvoir exécuter une requête SQL:
If
ObjFSO.FileExists
(
Fichier_Source) =
True
Then
Set
ObjFile =
ObjFSO.GetFile
(
Fichier_Source) ' Pointe sur le fichier.
Anc_Attributes =
ObjFile.Attributes
' Mémorise les attributs.
ObjFile.Attributes
=
0
' Efface les attributs.
Else
Err
.Raise
vbObjectError
, "TS_ImporterDepuisClasseurAvecSQL"
, "Le fichier ["
&
Fichier_Source &
"] n'a pas été trouvé."
End
If
' Ouvre le classeur source si le mot de passe existe ou si le nom d'un tableau structuré est passé
' en argument, sauf s'il était déjà ouvert:
If
MotDePasseOuverture <>
""
Or
MotDePasseEcriture <>
""
Or
Left
(
Nom_Tableau_Source, 1
) <>
"["
Then
' Mémorise les classeurs ouverts:
For
i =
1
To
Workbooks.Count
Classeurs =
Classeurs &
";"
&
Workbooks
(
i).Name
&
";"
Next
i
' Ouvre le classeur source seulement s'il n'est pas déjà ouvert:
NomCourt =
Mid
(
Fichier_Source, 1
+
InStrRev
(
Fichier_Source, "\"
))
If
InStr
(
1
, Classeurs, ";"
&
NomCourt &
";"
) =
0
Then
' Désactive les macros pour ouvrir le fichier sans lancer "Workbook_Open":
If
UCase
(
Right
(
Fichier_Source, 5
)) <>
".XLSX"
Then
Dim
secAutomation As
MsoAutomationSecurity
secAutomation =
Application.AutomationSecurity
Application.AutomationSecurity
=
msoAutomationSecurityForceDisable
' Ouvre le fichier:
Set
Wk =
Workbooks.Open
(
Fichier_Source, False
, False
, , MotDePasseOuverture, MotDePasseEcriture, True
)
' Réactive les macros:
Application.AutomationSecurity
=
secAutomation
Else
' Ouvre le fichier:
Set
Wk =
Workbooks.Open
(
Fichier_Source, False
, False
, , MotDePasseOuverture, MotDePasseEcriture, True
)
End
If
' Récupère la plage si un nom de tableau structuré a été passé en argument:
If
Left
(
Nom_Tableau_Source, 1
) <>
"["
Then
Range
(
Nom_Tableau_Source).ListObject.ShowHeaders
=
True
' Affiche l'en-tête.
Range
(
Nom_Tableau_Source).ListObject.ShowTotals
=
False
' Masque les totaux.
Nom_Tableau_Source =
Range
(
Nom_Tableau_Source).Parent.Name
' Récupère la feuille.
End
If
Else
' Si le classeur était déjà ouvert il faut l'activer pour récupérer l'adresse du tableau structuré:
If
Application.Workbooks
(
NomCourt).ReadOnly
=
True
Then
Err
.Raise
vbObjectError
, "TS_ImporterDepuisClasseurAvecSQL"
, "Le classeur "
&
NomCourt &
" ne doit pas être en lecture seule "
_
&
"s'il est déjà ouvert pour pouvoir faire une requête SQL."
End
If
Application.Workbooks
(
NomCourt).Activate
If
Left
(
Nom_Tableau_Source, 1
) <>
"["
Then
Range
(
Nom_Tableau_Source).ListObject.ShowHeaders
=
True
' Affiche l'en-tête.
Range
(
Nom_Tableau_Source).ListObject.ShowTotals
=
False
' Masque les totaux.
Nom_Tableau_Source =
Range
(
Nom_Tableau_Source).Parent.Name
' Récupère la feuille.
End
If
End
If
End
If
' Supprime les crochets dans le nom du tableau source (pas besoin de ces crochets pour la suite):
Nom_Tableau_Source =
Replace
(
Nom_Tableau_Source, "["
, ""
)
Nom_Tableau_Source =
Replace
(
Nom_Tableau_Source, "]"
, ""
)
Nom_Tableau_Source =
"["
&
Nom_Tableau_Source &
"$]"
' Création d'une connexion:
Set
Cnn =
CreateObject
(
"ADODB.Connection"
) ' Liaison anticipée => Set Cnn = New ADODB.Connection
Cnn.Open
"Provider=Microsoft.ACE.OLEDB.12.0;"
&
_
"Data Source="
&
Fichier_Source &
";"
&
_
"Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1;Readonly=False"";"
' Lecture du schéma pour vérifier que la feuille existe:
' voir https://www.w3schools.com/asp/met_conn_openschema.asp
Dim
RstSchema, Ok As
Boolean
Set
RstSchema =
Cnn.OpenSchema
(
20
)
Do
Until
RstSchema.EOF
If
"["
&
RstSchema!TABLE_NAME &
"]"
=
Nom_Tableau_Source Then
Ok =
True
: Exit
Do
RstSchema.MoveNext
Loop
RstSchema.Close
' Si la feuille n'existe pas alors le signaler (ne pas générer d'erreur car parfois la feuille n'est pas reconnue dans le schéma):
If
Ok =
False
Then
ErreurFeuillle =
"La feuille "
&
Nom_Tableau_Source &
" n'existe pas dans le fichier ["
&
Fichier_Source &
"]."
' Exécute une requête SQL sur un jeu d'enregistrements de la feuille:
Set
Rs =
CreateObject
(
"ADODB.Recordset"
) ' Liaison anticipée => Set Rs = New ADODB.Recordset
Rs.Open
"SELECT "
&
IIf
(
StrChamps <>
""
, StrChamps, "*"
) &
" FROM "
&
Nom_Tableau_Source &
" "
&
StrSQL, Cnn, 1
, 2
, 1
' Liaison anticipée => adOpenKeyset, adLockPessimistic, adCmdText
' S'il y a des enregistrements concernés alors les copier dans le tableau structuré destination:
If
Rs.EOF
=
False
Then
TS_ImporterDepuisClasseurAvecSQL =
TS_CopierUnTableau
(
Rs, TS_Dest, Méthode, TS_Valeurs)
Else
TS_ImporterDepuisClasseurAvecSQL =
0
End
If
' Ferme la connexion:
Cnn.Close
' Fin du traitement:
Gest_Err
:
' Ferme le lien:
Set
Cnn =
Nothing
' Fermeture du classeur:
If
Not
Wk Is
Nothing
Then
Wk.Saved
=
True
Wk.Close
False
Set
Wk =
Nothing
End
If
ThisWorkbook.Activate
' Restaure les attributs:
If
Not
ObjFile Is
Nothing
Then
Set
ObjFile =
ObjFSO.GetFile
(
Fichier_Source) ' Pointe sur le fichier.
ObjFile.Attributes
=
Anc_Attributes ' Restaure les attributs.
End
If
' Restaure l'affichage d'origine:
Application.ScreenUpdating
=
Anc_ScreenUpdating
Application.Cursor
=
Anc_Cursor
' Gestion des erreurs:
If
Err
.Number
=
-
2147217904
Then
Err
.Clear
' pas de donnée.
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
ErreurFeuillle <>
""
Then
TS_Err_Description =
ErreurFeuillle
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ImporterDepuisClasseurAvecSQL"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ImporterDepuisClasseurAvecSQL"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VI-N. TS_ImporterFichierTexteAvecSQL▲
La fonction TS_ImporterFichierTexteAvecSQL importe, dans un tableau structuré existant, les données d'un fichier texte dont les champs sont délimités par un caractère particulier, généralement point-virgule, suivant éventuellement une requête SQL.
Les données sources doivent impérativement avoir un en-tête avec des noms de champs uniques pour pouvoir exécuter une requête.
Ses arguments sont :
- Fichier_Source : le fichier texte qui contient les sources (chemin complet + nom avec l'extension) ;
- Délimiteur : le caractère délimiteur des champs ;
- AvecEntête : Indique si le fichier source à un en-tête (
True
) ou non (False
) ; - ListeColonnes : le format des colonnes à analyser (ou vide pour tout reprendre au format général) séparés par une virgule. Si la liste ne reprend pas toutes les colonnes, les colonnes non renseignées ne sont pas traitées.
Liste des formats disponibles (vous pouvez en créer d'autres) :
1 = Général (xlGeneralFormat) (les numériques de plus de 15 caractères sont tronqués et ceux avec une virgule sont considérés comme du texte),
2 = Force le texte en le préfixant par " ' ",
3 = Format de date M/J/A (xlMDYFormat),
4 = Format de date J/M/A (xlDMYFormat),
5 = Format de date A/M/J (xlYMDFormat),
6 = Format de date M/A/J (xlMYDFormat),
7 = Format de date J/A/M (xlDYMFormat),
8 = Format de date A/J/M (xlYDMFormat),
9 = La colonne n'est pas analysée (xlSkipColumn),
10 = Numérique,
11 = Numérique arrondis à 2 chiffres après la virgule,
12 = Texte sans les espaces de gauche,
13 = Texte sans les espaces de droite,
14 = Texte sans les espaces de gauche et de droite,
15 = Format JJMMAAAA transformé en date,
16 = Format AAAAMMJJ transformé en date ; - TS_Dest : le tableau structuré destination (de type Range) situé dans le classeur contenant cette fonction ;
- Méthode : indique si les données importées doivent remplacer celles existantes dans le tableau structuré ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes ; - StrSQL : (facultatif) la requête SQL, basée sur le nom des colonnes du tableau structuré destination et non pas sur les noms des champs du fichier texte.
La fonction renvoie : le nombre de lignes importées ou -1 si erreur.
Remarques :
- si le fichier texte a plus de colonnes que le tableau destination : les colonnes en surplus sont ignorées ;
- si le fichier texte a moins de colonnes que le tableau destination : les colonnes manquantes sont vides.
Exemples pour importer dans le tableau structuré destination nommé « TS_1 » ce fichier texte nommé « Eleves.csv » qui a comme délimiteur un point-virgule :
Pour importer tous les champs avec le format par défaut (format général) :
Call
TS_ImporterFichierTexteAvecSQL
(
"C:\_Formation_VBA\Eleves.csv"
, ";"
, True
, _
""
, _
Range
(
"TS_1"
), TS_RemplacerDonnées)
Ce qui donne ce résultat (les notes avec une virgule sont considérées comme étant du texte, le numéro de dossier est tronqué) :
Pour importer tous les champs avec format numérique pour les notes, format date pour les dates, format texte pour les dossiers :
Call
TS_ImporterFichierTexteAvecSQL
(
"C:\_Formation_VBA\Eleves.csv"
, ";"
, True
, _
"1, 1, 10, 4, 1, 1, 1, 1, 2"
, _
Range
(
"TS_1"
), TS_RemplacerDonnées)
Call
TS_FormatColonne
(
Range
(
"TS_1"
), "Note"
, "0.0"
)
Call
TS_FormatColonne
(
Range
(
"TS_1"
), "Date"
, "dd/mm/yyyy"
)
Pour importer uniquement des champs Nom, Prénom, Note, Souhaits, pour les notes supérieures à 10 et les trier par nom :
Call
TS_ImporterFichierTexteAvecSQL
(
"C:\_Formation_VBA\Eleves.csv"
, ";"
, True
, _
"1, 1, 10, 9, 9, 9, 1"
, _
Range
(
"TS_1"
), TS_RemplacerDonnées, _
"WHERE [Note] > 10 ORDER BY [Nom]"
)
Ce qui donne ce résultat :
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Function
TS_ImporterFichierTexteAvecSQL
(
ByVal
Fichier_Source As
String
, _
ByVal
Délimiteur As
String
, _
ByVal
AvecEntête As
Boolean
, _
ByVal
ListeColonnes As
String
, _
ByVal
TS_Dest As
Range, _
ByVal
Méthode As
Enum_CopierDonnées, _
Optional
ByVal
StrSQL As
String
=
""
) As
Long
'------------------------------------------------------------------------------------------------------
' Copie en valeur les données d'un fichier texte dont les champs sont délimités par un caractère particulier,
' généralement point-virgule, suivant éventuellement une requête SQL.
'------------------------------------------------------------------------------------------------------
' Fichier_Source : le fichier texte qui contient les sources (chemin complet + nom avec l'extension).
' Délimiteur : le délimiteur des champs.
' AvecEntête : Indique si le fichier source à un en-tête (True) ou non (False).
' ListeColonnes : le format des colonnes à analyser (ou vide pour tout reprendre au format général) séparés
' par une virgule. Si la liste ne reprend pas toutes les colonnes, les colonnes non renseignées
' ne sont pas traitées.
' Liste des formats disponibles (vous pouvez en créer d'autres):
' 1 = Général (xlGeneralFormat) (les numériques de plus de 15 caractères sont tronqués et
' ceux avec une virgule sont considérés comme du texte).
' 2 = Force le Texte en le préfixant par "'".
' 3 = Format de date M/J/A (xlMDYFormat).
' 4 = Format de date J/M/A (xlDMYFormat).
' 5 = Format de date A/M/J (xlYMDFormat).
' 6 = Format de date M/A/J (xlMYDFormat).
' 7 = Format de date J/A/M (xlDYMFormat).
' 8 = Format de date A/J/M (xlYDMFormat).
' 9 = La colonne n'est pas analysée (xlSkipColumn).
' 10 = Numérique.
' 11 = Numérique arrondis à 2 chiffres après la virgule.
' 12 = Texte sans les espaces de gauche.
' 13 = Texte sans les espaces de droite.
' 14 = Texte sans les espaces de gauche et de droite.
' 15 = Format JJMMAAAA transformé en date.
' 16 = Format AAAAMMJJ transformé en date.
' TS_Dest : le tableau structuré destination (de type Range) situé sur le classeur contenant cette fonction.
' Méthode : énumération Enum_CopierDonnées =
' TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
' TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
' StrSQL : (facultatif) la requête SQL, basée sur le nom des colonnes du tableau structuré destination et
' non pas sur les noms des champs du fichier texte.
'------------------------------------------------------------------------------------------------------
' Renvoie : le nombre de lignes importées ou -1 si erreur.
'------------------------------------------------------------------------------------------------------
' Remarques :
' - Si le fichier texte a plus de colonnes que le tableau destination : les colonnes en surplus sont ignorées.
' - Si le fichier texte a moins de colonnes que le tableau destination : les colonnes manquantes sont vides.
'------------------------------------------------------------------------------------------------------
Dim
FormatColonne As
Variant
Dim
Ligne As
String
Dim
NumFichier As
Long
Dim
Lu As
Long
, Taille As
Long
Dim
NbLignes As
Long
Dim
y As
Long
, x As
Integer
, NbCol As
Integer
Dim
V, T, Lecture
(
)
Dim
NumCol As
Integer
, Mt As
Double
Dim
Anc_Cursor As
Long
, Anc_ScreenUpdating As
Boolean
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Désactive l'affiche écran:
Anc_Cursor =
Application.Cursor
Application.Cursor
=
xlWait
Anc_ScreenUpdating =
Application.ScreenUpdating
Application.ScreenUpdating
=
False
' Lecture du fichier et mémorisation des données:
NumFichier =
FreeFile
Taille =
FileLen
(
Fichier_Source)
Application.StatusBar
=
"Lecture du fichier : "
&
Fichier_Source
Open Fichier_Source For
Input As
#NumFichier
' Saute l'en-tête:
If
AvecEntête =
True
Then
Line Input #NumFichier, Ligne
' Boucle sur les lignes du fichier:
Do
While
Not
EOF
(
NumFichier)
Line Input #NumFichier, Ligne
' Compte le nombre d'octets lus et le nombre de lignes:
Lu =
Lu +
Len
(
Ligne) +
2
NbLignes =
NbLignes +
1
' Mémorise la ligne lue:
ReDim
Preserve
Lecture
(
1
To
NbLignes)
Lecture
(
NbLignes) =
Ligne
' Affiche la progression de la lecture:
If
NbLignes Mod
1000
=
0
Then
Application.StatusBar
=
"Lecture du fichier : "
&
Format
(
Lu /
Taille, "0%"
)
DoEvents
End
If
Loop
' Ferme le fichier:
Close #NumFichier
' Analyse du format des colonnes à traiter:
V =
Split
(
Lecture
(
1
), Délimiteur) ' Compte le nombre de colonnes dans la source.
ListeColonnes =
Replace
(
ListeColonnes, " "
, ""
) ' Suppression des espaces dans la liste des colonnes demandées.
ListeColonnes =
Replace
(
ListeColonnes, ";"
, ","
) ' Remplacement du séparateur.
' Si rien n'est renseigné alors par défaut prendre toutes les colonnes:
If
ListeColonnes =
""
Then
ListeColonnes =
String
(
UBound
(
V) +
1
, "x"
): ListeColonnes =
Replace
(
ListeColonnes, "x"
, "1,"
)
If
Right
(
ListeColonnes, 1
) =
","
Then
ListeColonnes =
Left
(
ListeColonnes, Len
(
ListeColonnes) -
1
)
ListeColonnes =
"x,"
&
ListeColonnes
FormatColonne =
Split
(
ListeColonnes, ","
)
' Compte le nombre de colonnes qu'il faudra traiter:
For
x =
1
To
UBound
(
FormatColonne)
If
FormatColonne
(
x) <>
9
Then
NbCol =
NbCol +
1
Next
x
' Traitement des colonnes:
ReDim
Données
(
1
To
NbLignes, 1
To
NbCol)
Application.StatusBar
=
"Correction des données..."
' Boucle sur les lignes à traiter:
For
y =
1
To
NbLignes
' Affiche la progression de temps en temps:
If
y Mod
1000
=
0
Then
Application.StatusBar
=
"Correction des données : "
&
Format
(
Lu /
Taille, "0%"
)
DoEvents
End
If
' Lecture de la ligne et la découpe avec le délimiteur:
V =
Split
(
Lecture
(
y), Délimiteur)
' Boucle sur les colonnes:
NumCol =
0
For
x =
1
To
UBound
(
FormatColonne)
' Si la colonne est à traiter:
If
FormatColonne
(
x) <>
9
Then
NumCol =
NumCol +
1
' Si la donnée n'est pas vide:
If
V
(
x -
1
) <>
""
Then
' Suivant le format de l'entrée:
Select
Case
FormatColonne
(
x)
Case
1
:
Case
2
: V
(
x -
1
) =
"'"
&
V
(
x -
1
)
Case
3
: T =
Split
(
V
(
x -
1
), "/"
): V
(
x -
1
) =
Format
(
DateValue
(
DateSerial
(
T
(
2
), T
(
0
), T
(
1
))), 0
)
Case
4
: T =
Split
(
V
(
x -
1
), "/"
): V
(
x -
1
) =
Format
(
DateValue
(
DateSerial
(
T
(
2
), T
(
1
), T
(
0
))), 0
)
Case
5
: T =
Split
(
V
(
x -
1
), "/"
): V
(
x -
1
) =
Format
(
DateValue
(
DateSerial
(
T
(
0
), T
(
1
), T
(
2
))), 0
)
Case
6
: T =
Split
(
V
(
x -
1
), "/"
): V
(
x -
1
) =
Format
(
DateValue
(
DateSerial
(
T
(
2
), T
(
0
), T
(
1
))), 0
)
Case
7
: T =
Split
(
V
(
x -
1
), "/"
): V
(
x -
1
) =
Format
(
DateValue
(
DateSerial
(
T
(
1
), T
(
2
), T
(
0
))), 0
)
Case
8
: T =
Split
(
V
(
x -
1
), "/"
): V
(
x -
1
) =
Format
(
DateValue
(
DateSerial
(
T
(
0
), T
(
2
), T
(
1
))), 0
)
Case
10
, 11
:
V
(
x -
1
) =
Replace
(
V
(
x -
1
), " "
, ""
)
V
(
x -
1
) =
Replace
(
V
(
x -
1
), ","
, "."
)
If
V
(
x -
1
) <>
""
Then
While
Not
Right
(
V
(
x -
1
), 1
) Like "[0-9%]"
And
Len
(
V
(
x -
1
)) >
0
V
(
x -
1
) =
Left
(
V
(
x -
1
), Len
(
V
(
x -
1
)) -
1
)
Wend
End
If
If
FormatColonne
(
x) =
11
Then
If
V
(
x -
1
) <>
""
And
Right
(
V
(
x -
1
), 1
) <>
"%"
Then
V
(
x -
1
) =
Replace
(
Round
(
Val
(
V
(
x -
1
)), 2
), ","
, "."
)
End
If
Case
12
: V
(
x -
1
) =
LTrim
(
V
(
x -
1
))
Case
13
: V
(
x -
1
) =
RTrim
(
V
(
x -
1
))
Case
14
: V
(
x -
1
) =
Trim
(
V
(
x -
1
))
Case
15
: V
(
x -
1
) =
Format
(
DateValue
(
DateSerial
(
Right
(
V
(
x -
1
), 4
), Mid
(
V
(
x -
1
), 3
, 2
), Left
(
V
(
x -
1
), 2
))), 0
)
Case
16
: V
(
x -
1
) =
Format
(
DateValue
(
DateSerial
(
Left
(
V
(
x -
1
), 4
), Mid
(
V
(
x -
1
), 5
, 2
), Right
(
V
(
x -
1
), 2
))), 0
)
End
Select
End
If
' Mémorise la donnée:
Données
(
y, NumCol) =
V
(
x -
1
)
End
If
Next
x
Next
y
' Alimentation du tableau structuré destination:
Application.StatusBar
=
""
' Si c'est une requête pour ajouter des données du fichier texte à celles existantes:
If
Méthode =
TS_AjouterDonnées And
StrSQL <>
""
Then
Dim
Copie1, Copie2
' Mémorise les données existantes:
Copie1 =
TS_MémoriseTableau
(
TS_Dest, TS_Valeurs)
' Les remplace par les données du fichier texte:
Call
TS_CopierUnTableau
(
Données, TS_Dest, TS_RemplacerDonnées, TS_Valeurs)
' Exécute une requête sur le données du tableau ainsi obtenu:
Call
TS_RequeteSQL
(
TS_Dest, ""
, StrSQL, TS_Dest, TS_RemplacerDonnées)
' Mémorise le résultat de la requête:
Copie2 =
TS_MémoriseTableau
(
TS_Dest, TS_Valeurs)
' Efface le tableau et restitue les données d'origine:
Call
TS_CopierUnTableau
(
Copie1, TS_Dest, TS_RemplacerDonnées, TS_Valeurs)
' Leur ajoute le résultat de la requête:
TS_ImporterFichierTexteAvecSQL =
TS_CopierUnTableau
(
Copie2, TS_Dest, TS_AjouterDonnées, TS_Valeurs)
Else
' Remplace les données existantes par les données du fichier texte:
TS_ImporterFichierTexteAvecSQL =
TS_CopierUnTableau
(
Données, TS_Dest, Méthode, TS_Valeurs)
' Si une requête est renseignée alors l'applique:
If
StrSQL <>
""
Then
TS_ImporterFichierTexteAvecSQL =
TS_RequeteSQL
(
TS_Dest, ""
, StrSQL, TS_Dest, Méthode)
End
If
' Gestion des erreurs:
Gest_Err
:
Application.StatusBar
=
""
Application.Cursor
=
Anc_Cursor
Application.ScreenUpdating
=
Anc_ScreenUpdating
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ImporterFichierTexteAvecSQL"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ImporterFichierTexteAvecSQL"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VI-O. TS_ImporterDepuisFichierHTML▲
La fonction TS_ImporterDepuisFichierHTML importe dans un tableau structuré existant les données d'un fichier au format HTML qui contient un tableau.
Si le tableau structuré n'a pas assez de colonnes, celles nécessaires seront créées automatiquement.
Les données importées sont soit ajoutées aux données existantes du tableau structuré soit les remplacent.
Le code est inspiré de cette discussion.
Ses arguments sont :
- TS : la plage (de type Range) du tableau structuré ;
- Fichier : le fichier HTML qui contient un tableau (chemin complet + nom avec l'extension) ;
- Méthode : indique si les données importées doivent remplacer celles existantes dans le tableau structuré ou y être ajoutées, suivant l'énumération personnelle Enum_CopierDonnées :
- TS_RemplacerDonnées : remplace les données existantes par les nouvelles,
- TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
La fonction renvoie : le nombre de lignes importées ou -1 en cas d'erreur.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ImporterDepuisFichierHTML
(
TS As
Range, Fichier As
String
, _
Méthode As
Enum_CopierDonnées) As
Long
'-----------------------------------------------------------------------------------------------
' Importe une table d'un fichier au format HTML.
' Les données sont recopiées dans le tableau structuré en remplacement des données existantes ou ajoutées.
' Sources:
' https://www.developpez.net/forums/d2150324/logiciels/microsoft-office/excel/macros-vba-excel/import-html-convertion-utf
'-----------------------------------------------------------------------------------------------
' TS : le tableau structuré où importer les données issues d'Access.
' S'il n'y pas assez de colonnes dans le tableau elles sont ajoutées.
' Fichier : le fichier HTML qui contient un tableau (chemin complet + nom avec l'extension).
' Méthode : énumération Enum_CopierDonnées =
' TS_RemplacerDonnées : remplace les données existantes par les nouvelles.
' TS_AjouterDonnées : ajoute les nouvelles données à la suite des données existantes.
'-----------------------------------------------------------------------------------------------
' Renvoie : le nombre de lignes importées ou -1 en cas d'erreur.
'-----------------------------------------------------------------------------------------------
Dim
i As
Long
, j As
Long
Dim
oDoc As
Object, HTMLTable As
Object
Dim
TableRow As
Object, TableCell As
Object, Donnee As
Object
Dim
NbOrigine As
Long
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Par défaut renvoie -1:
TS_ImporterDepuisFichierHTML =
-
1
' Mémorise la présentation:
Dim
Anc_Screen As
Boolean
Anc_Screen =
Application.ScreenUpdating
Application.ScreenUpdating
=
False
Dim
Anc_Cursor As
Long
Anc_Cursor =
Application.Cursor
Application.Cursor
=
xlWait
' Bloque les calculs:
Dim
AncCalculation
AncCalculation =
Application.Calculation
Application.Calculation
=
xlCalculationManual
' Charge le fichier HTML:
Set
oDoc =
CreateObject
(
"HtmlFile"
)
With
CreateObject
(
"ADODB.Stream"
)
.Open
.Type
=
1
' 1=adTypeBinary
.LoadFromFile
Fichier
.Type
=
2
' 2=adTypeText
.Charset
=
"utf-8"
oDoc.body.innerHTML
=
.ReadText
(-
1
) ' -1=adReadAll
.Close
End
With
' Recherche une structure de type tableau et quitte si aucun tableau trouvé:
Set
HTMLTable =
oDoc.getElementsByTagName
(
"table"
)(
0
)
If
HTMLTable Is
Nothing
Then
GoTo
Gest_Err
' S'il faut remplacer ou ajouter les données:
Select
Case
Méthode
Case
TS_RemplacerDonnées
Call
TS_EffacerToutesLignes
(
TS)
Call
TS_SupprimerPlusieursLignes
(
TS, 2
, 0
)
i =
1
Case
TS_AjouterDonnées
NbOrigine =
TS_Nombre_Lignes
(
TS)
i =
NbOrigine +
1
End
Select
' Boucle sur les éléments du tableau:
For
Each
TableRow In
HTMLTable.getElementsByTagName
(
"tr"
)
' Si la ligne contient un tableau:
If
TableRow.getElementsByTagName
(
"td"
).Length
>
0
Then
' Boucle sur chaque colonne du tableau:
Set
TableCell =
TableRow.getElementsByTagName
(
"td"
)
j =
1
For
Each
Donnee In
TableCell
' Ajout d'un colonne s'il n'y en a pas assez dans le tableau structuré:
If
j >
TS_Nombre_Colonnes
(
TS) Then
Call
TS_AjouterUneColonne
(
TS, 0
, ""
)
' Pose la données dans le tableau structuré:
TS.ListObject.DataBodyRange
(
i, j).Value
=
Donnee.innerText
j =
j +
1
Next
i =
i +
1
End
If
Next
' Renvoie le nombre de lignes ajoutées:
TS_ImporterDepuisFichierHTML =
TS_Nombre_Lignes
(
TS) -
NbOrigine
' Fin du traitement:
Gest_Err
:
' Restaure la présentation:
Application.Calculation
=
AncCalculation
Application.ScreenUpdating
=
Anc_Screen
Application.Cursor
=
Anc_Cursor
' Erreurs:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ImporterDepuisFichierHTML"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ImporterDepuisFichierHTML"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VII. Vos contributions▲
Ce chapitre reprend les fonctions qui m'ont été proposées ou que certaines discussions m'ont inspiré.
VII-A. TS_CelluleActive▲
la fonction TS_CelluleActive indique si la cellule active est dans le tableau structuré passé en argument. Si c'est le cas alors elle renseigne les variables « Colonne » et « Ligne » des coordonnées de la cellule dans le tableau et renvoie la cellule active.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : si la cellule active est dans le tableau, cette variable contiendra le numéro de la colonne ;
- Ligne : si la cellule active est dans le tableau, cette variable contiendra le numéro de la ligne.
La fonction renvoie : la cellule active (la première si c'est une plage de plusieurs cellules, ou Nothing
si la cellule active n'est pas dans le tableau structuré (ou si une erreur s'est produite).
Exemple d'utilisation pour savoir si la cellule active est à l'intérieur du tableau structuré « TS_Eleves » et si c'est le cas pour afficher dans la fenêtre d'exécution sa position et sa valeur :
'------------------------------------------------------------------------------------------------
Sub
Exemple
(
)
'------------------------------------------------------------------------------------------------
Dim
r As
Range, Colonne As
Long
, Ligne As
Long
Set
r =
TS_CelluleActive
(
Range
(
"TS_Eleves"
), Colonne, Ligne)
If
Not
r Is
Nothing
Then
Debug.Print
Colonne, Ligne, r.Value
End
Sub
'------------------------------------------------------------------------------------------------
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_CelluleActive
(
TS As
Range, ByRef
Colonne As
Long
, ByRef
Ligne As
Long
) As
Range
'------------------------------------------------------------------------------------------------
' Indique si la cellule active est dans le Tableau Structuré passé en argument.
' Si c'est le cas alors elle renseigne "Colonne" et "Ligne" des coordonnées de la cellule dans le tableau
' et renvoie la cellule active.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Si la cellule active est dans le tableau, contiendra le numéro de la colonne.
' Ligne : Si la cellule active est dans le tableau, contiendra le numéro de la ligne.
'------------------------------------------------------------------------------------------------
' Renvoie : La cellule active (la première si c'est une plage de plusieurs cellules,
' ou Nothing si la cellule active n'est pas dans le tableau structuré (ou erreur).
'------------------------------------------------------------------------------------------------
' Renseigne : Colonne et Ligne (voir ci-dessus).
'------------------------------------------------------------------------------------------------
Dim
r As
Range, x As
Long
, y As
Long
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Si la cellule active est dans le tableau structuré:
If
TS.ListObject.Active
=
True
Then
Set
r =
ActiveCell
y =
r.Row
-
TS.Row
+
1
x =
r.Column
-
TS.Column
+
1
' Si elle est à l'intérieur du tableau (hors en-têtes et totaux):
If
y <=
TS.Rows.Count
And
y >
0
Then
Colonne =
x
Ligne =
y
Set
TS_CelluleActive =
r
End
If
End
If
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_CelluleActive"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_CelluleActive"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VII-B. TS_ObjetInserer▲
la fonction TS_ObjetInserer insère un objet dans une cellule du tableau structuré passé en argument. Un objet peut être une image (cas classique) mais aussi tout autre type de fichier supporté par votre version d'Excel, tels que les fichiers au format PDF, les fichiers son, les fichiers texte, les classeurs Excel...
Un double-clic (ou un clic droit) sur l'objet l'ouvre (testé sur les versions 2016 et 365).
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le nom ou le numéro de la colonne concernée. Si ce nom est vide ou 0, alors la dernière colonne du tableau est traitée ;
- Ligne : la ligne concernée. Si 0 est renseigné alors prend la dernière ligne ;
- Fichier : le nom complet du fichier (avec son chemin) ;
- Nom : le nom à donner à l'objet (laissez à vide pour garder le nom attribué automatiquement par Excel), plusieurs objets peuvent avoir le même nom ;
- LargeurObjet : la largeur de l'objet, laissez à 0 pour prendre la largeur par défaut (le ratio est conservé) ;
- HauteurObjet : la hauteur de l'objet, laissez à 0 pour prendre la hauteur par défaut (le ratio est conservé).
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
remarques :
- si la feuille n'est pas protégée l'utilisateur peut déplacer l'objet (voire le supprimer) et les objets ne sont pas masqués sur les cellules filtrées ;
- l'incorporation des objets fait gonfler la taille du classeur.
Cette technologie est donc à utiliser avec modération.
Suivant votre situation, pensez à l'alternative qui consiste à insérer un lien hypertexte dans la cellule ou une image dans le commentaire, voir la fonction TS_ModifCellule.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ObjetInserer
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
ByVal
Ligne As
Long
, _
ByVal
Fichier As
Variant
, _
Optional
ByVal
Nom As
String
=
""
, _
Optional
LargeurObjet As
Long
=
0
, _
Optional
HauteurObjet As
Long
=
0
) As
Boolean
'------------------------------------------------------------------------------------------------
' Insère un objet dans une cellule.
' L'objet peut être une image, un fichier texte, un classeur Excel...
' Plusieurs objets peuvent avoir le même nom.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Ligne : La ligne concernée.
' Si 0 alors prend la dernière ligne du Tableau Structuré.
' Fichier : Le nom complet du fichier (avec son chemin).
' Nom : Le nom à appliquer à l'objet (s'il est renseigné).
' LargeurObjet : Largeur de l'objet, ou 0 pour la taille par défaut.
' HauteurObjet : Hauteur de l'objet, ou 0 pour la taille par défaut.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim
Shp As
Shape
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Contrôle la cohérence de la ligne passée en argument:
If
Ligne >=
0
Then
Ligne =
TS_IndexLigne
(
TS, Ligne)
If
Ligne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
End
If
' Supprime l'éventuel objet existant dans la cellule:
For
Each
Shp In
Sheets
(
TS.Parent.Name
).Shapes
If
(
Abs
(
Shp.Left
-
TS.ListObject.DataBodyRange
(
Ligne, Colonne).Left
) <
2
_
And
Abs
(
Shp.Top
-
TS.ListObject.DataBodyRange
(
Ligne, Colonne).Top
) <
2
) _
Then
Shp.Delete
End
If
Next
Shp
' Pose l'objet dans la cellule et définit son nom (plusieurs objets peuvent avoir le même nom):
With
Sheets
(
TS.Parent.Name
).OLEObjects.Add
(
Filename:=
Fichier)
.Left
=
TS.ListObject.DataBodyRange
(
Ligne, Colonne).Left
.Top
=
TS.ListObject.DataBodyRange
(
Ligne, Colonne).Top
.Width
=
IIf
(
LargeurObjet >
0
, LargeurObjet, TS.ListObject.DataBodyRange
(
Ligne, Colonne).Width
)
.Height
=
IIf
(
HauteurObjet >
0
, HauteurObjet, TS.ListObject.DataBodyRange
(
Ligne, Colonne).Height
)
On
Error
Resume
Next
If
Nom <>
""
Then
.Name
=
Nom ' Ne marche pas sur les fichiers PDF
Err
.Clear
End
With
' Si la hauteur et la largeur sont indiquées il ne faut pas respecter le ratio d'origine:
If
LargeurObjet >
0
And
HauteurObjet >
0
Then
Dim
i As
Integer
i =
Sheets
(
TS.Parent.Name
).Shapes.Count
Sheets
(
TS.Parent.Name
).Shapes
(
i).LockAspectRatio
=
msoFalse
Sheets
(
TS.Parent.Name
).Shapes
(
i).Width
=
LargeurObjet
Sheets
(
TS.Parent.Name
).Shapes
(
i).Height
=
HauteurObjet
End
If
' Renvoie VRAI:
TS_ObjetInserer =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ObjetInserer"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ObjetInserer"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VII-C. TS_ObjetSupprimer▲
la fonction TS_ObjetSupprimer supprime un objet du tableau structuré passé en argument.
En principe l'objet a été inséré par la fonction TS_ObjetInserer.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Nom : le nom de l'objet (laissez à vide pour supprimer tous les objets de la feuille), plusieurs objets peuvent avoir le même nom.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ObjetSupprimer
(
TS As
Range, _
Nom As
String
) As
Boolean
'------------------------------------------------------------------------------------------------
' Supprime les objets du nom passé en argument.
' Plusieurs objets peuvent avoir le même nom.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Nom : Le nom de l'objet. Si non renseigné alors supprime tous les objets de la feuille.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim
Shp As
Shape
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Supprime l'objet si le nom est renseigné ou tous les objets de la feuille si
' le nom n'est pas renseigné:
For
Each
Shp In
Sheets
(
TS.Parent.Name
).Shapes
If
Shp.Name
=
Nom Or
Nom =
""
Then
Shp.Delete
End
If
Next
Shp
' Renvoie VRAI:
TS_ObjetSupprimer =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ObjetSupprimer"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ObjetSupprimer"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VII-D. TS_ObjetNom▲
la fonction TS_ObjetNom revoie le nom de l'objet contenu dans une cellule du tableau structuré passé en argument.
En principe l'objet a été inséré par la fonction TS_ObjetInserer.
L'objet ne doit pas avoir été déplacé par l'utilisateur pour pouvoir être retrouvé par cette fonction.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le numéro de la colonne, ou le nom de la colonne. Si 0 est renseigné alors prend la dernière colonne ;
- Ligne : la ligne concernée. Si 0 est renseigné alors prend la dernière ligne.
La fonction renvoie : le nom de l'objet de la cellule s'il est trouvé ou vide.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ObjetNom
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
ByVal
Ligne As
Long
) As
String
'------------------------------------------------------------------------------------------------
' Renvoie le nom de l'objet d'une une cellule.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Ligne : La ligne concernée.
' Si 0 alors prend la dernière ligne du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : le nom de l'objet de la cellule s'il est trouvé ou vide.
'------------------------------------------------------------------------------------------------
Dim
Shp As
Shape
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne =
TS_IndexColonne
(
TS, Colonne)
If
Colonne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
' Contrôle la cohérence de la ligne passée en argument:
If
Ligne >=
0
Then
Ligne =
TS_IndexLigne
(
TS, Ligne)
If
Ligne =
-
1
Then
Err
.Raise
vbObjectError
, , TS_Err_Description
End
If
' Boucle sur les objet de la feuille pour retrouver celui aux coordonnées passées:
For
Each
Shp In
Sheets
(
TS.Parent.Name
).Shapes
If
(
Abs
(
Shp.Left
-
TS.ListObject.DataBodyRange
(
Ligne, Colonne).Left
) <
2
_
And
Abs
(
Shp.Top
-
TS.ListObject.DataBodyRange
(
Ligne, Colonne).Top
) <
2
) _
Then
TS_ObjetNom =
Shp.Name
Exit
For
End
If
Next
Shp
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ObjetNom"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ObjetNom"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VII-E. TS_ObjetRenommer▲
la fonction TS_ObjetRenommer renomme un objet du tableau structuré passé en argument.
En principe l'objet a été inséré par la fonction TS_ObjetInserer.
Si plusieurs objets ont le même nom tous sont renommés.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- AncienNom : le nom de l'objet qu'il faut renommer ;
- NouveauNom : le nouveau nom de l'objet.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ObjetRenommer
(
TS As
Range, _
AncienNom As
String
, _
NouveauNom As
String
) As
Boolean
'------------------------------------------------------------------------------------------------
' Renomme un objet.
' Plusieurs objets peuvent avoir le même nom.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' AncienNom : Le nom de l'objet qu'il faut renommer.
' NouveauNom : Le nouveau nom de l'objet.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim
Shp As
Shape
' Gestion des erreurs:
On
Error
GoTo
Gest_Err
Err
.Clear
' Boucle sur les objets de la feuille (plusieurs objets peuvent avoir le même nom):
For
Each
Shp In
Sheets
(
TS.Parent.Name
).Shapes
If
Shp.Name
=
AncienNom Then
Shp.Name
=
NouveauNom
Next
Shp
' Renvoie VRAI:
TS_ObjetRenommer =
True
' Fin du traitement:
Gest_Err
:
TS_Err_Number =
Err
.Number
TS_Err_Description =
Err
.Description
If
Err
.Number
<>
0
Then
If
TS_Méthode_Err =
TS_Générer_Erreur Then
Err
.Raise
TS_Err_Number, "TS_ObjetRenommer"
, TS_Err_Description
If
TS_Méthode_Err =
TS_MsgBox_Erreur Then
MsgBox
TS_Err_Number &
" : "
&
TS_Err_Description, vbInformation
, "TS_ObjetRenommer"
End
If
Err
.Clear
End
Function
'------------------------------------------------------------------------------------------------
VII-F. TS_ModifierListeValidation▲
la fonction TS_ModifierListeValidation met à jour une liste de validation dont la source est une colonne d'un tableau structuré.
Une alternative est de renseigner =
INDIRECT
(
"Tableau[Colonne]"
dans la source des données de validation où "Tableau" est le nom du tableau structuré et "Colonne" le nom de la colonne. Ce qui met à jour automatiquement la liste de validation en cas de modification de la source.
Cette fonction permet de référencer différentes sources à une même liste de validation.
Ses arguments sont :
- TS : la plage (de type Range) qui représente le tableau structuré ;
- Colonne : le numéro de la colonne ou le nom de la colonne concernée, ou 0 pour traiter la dernière colonne ;
- Cellule : la cellule (de type Range) qui contient la liste de validation.
La fonction renvoie : True
si tout s’est bien passé ou False
dans le cas contraire.
Le code de la fonction :
'------------------------------------------------------------------------------------------------
Public
Function
TS_ModifierListeValidation
(
TS As
Range, _
ByVal
Colonne As
Variant
, _
ByVal
Cellule As
Range) As
Boolean
'------------------------------------------------------------------------------------------------
' Modifie la liste de validation d'une cellule en prenant la colonne d'un tableau structuré
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
' Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Cellule : La cellule qui contient la liste de validation à modifier.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Exemple pour modifier la liste de validation de la cellule B11 d'après la colonne "Nom" du
' tableau structuré nommé "Tableau1" :
' Call TS_ModifierListeValidation(Range("Tableau1"), "Nom", Range("B11"))
'------------------------------------------------------------------------------------------------
' Autres méthodes:
' https://www.developpez.net/forums/d1902678/logiciels/microsoft-office/excel/contribuez/referencer-colonne-d-tableau-structure-validation-donnees/
' Créer un nom à l'aide du gestionnaire des noms qui fera référence à cette colonne par exemple
' tblArt_ref qui fera référence à T_Article[Ref] et ensuite faire référence à ce nom dans la Validation de données.
' Utiliser la fonction INDIRECT comme ici : =INDIRECT("Tableau1[Nom]")
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On
Error