Gérer en VBA les segments et les chronologies

Fonctions en VBA pour gérer des segments et des chronologies sur les tableaux structurés d’Excel

Laurent Ott

Cette documentation propose, aux développeurs en VBA, des fonctions pour gérer des segments et des chronologies sur les tableaux structurés d’Excel.
Si les utilisateurs peuvent facilement ajouter manuellement des segments pour filtrer les données d’un tableau structuré, vous allez constater, dans cette documentation, que l’utilisation du VBA permettra aux développeurs d’en décupler les avantages…
De même, les chronologies d'ordinaire réservées aux tableaux et graphiques croisés dynamiques pourront désormais être utilisées pour filtrer un tableau structuré.

- Titre : Gérer en VBA les segments et les chronologies

- Auteur : Laurent Ott

- Parution : 1 mai 2026

- Mise à jour : 1 mai 2026

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

Voir également :

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

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

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

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

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

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

- Comprendre la méthode de factorisation du Crible Quadratique

- Programmation en VBA de menus personnalisés pour Excel

- Manipuler les données des bases Access depuis Excel

- Transfert des fichiers volumineux sous Outlook

- Algorithme ECM de factorisation par les courbes elliptiques

- Un classeur Excel multi-utilisateur

- Compresser/décompresser des fichiers au format ZIP

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

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

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

- Utiliser une collection ArrayList à plusieurs dimensions

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

- Les cryptosystèmes RSA et AES-256

- Fonctions en VBA pour gérer les segments et les chronologies

Sommaire

- I. Introduction

- II. Utiliser les segments sur un tableau structuré

- II-1. Fonctions pour gérer les segments

- II-1-A. SegmentExiste

- II-1-B. SegmentCreer

- II-1-C. SegmentStyle

- II-1-D. SegmentBoutons

- II-1-E. SegmentTaille

- II-1-F. SegmentDeplacer

- II-1-G. SegmentSupprimer

- II-1-H. SegmentEstFiltre

- II-1-I. SegmentFiger

- II-2. Fonctions pour gérer les éléments d’un segment

- II-2-A. SegmentElementExiste

- II-2-B. SegmentCompterElements

- II-2-C. SegmentListeElements

- II-2-D. SegmentActiverUnElement

- II-2-E. SegmentActiverListeElements

- II-2-F. SegmentElementEstActif

- II-2-G. SegmentEstAvecDonnees

- II-2-H. SegmentDesactiverUnElement

- II-2-I. SegmentEffacerTousLesFiltres

- II-2-J. SegmentSaisirSelection

- II-3. Exemples de gestion des éléments d’un segment

- II-4. Capter un changement de sélection dans un segment lié à un tableau structuré

- III. Utiliser une chronologie sur un tableau structuré

- III-1. Fonctions pour gérer les chronologies

- III-1-A. ChronologieExiste

- III-1-B. ChronologieStyle

- III-1-C. ChronologieTaille

- III-1-D. ChronologieInfos

- III-1-E. ChronologieFiltrer

- III-1-F. ChronologieEffacer

- III-1-G. ChronologieActualiser

- III-2. Capter un changement de sélection dans une chronologie liée à un TCD

- IV. Démonstration

- V. Conclusion

- VI. Remerciements

- VII. Le fichier joint

- VIII. Annexe - Le code source

I - Introduction

Dans une autre documentation destinée aux développeurs en VBA pour Excel, Fonctions en VBA pour gérer les Tableaux Structurés d'Excel, je présentais les avantages que les tableaux structurés procurent aux utilisateurs, 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.

Mais, j’avais omis d’évoquer l’usage des segments, pourtant plébiscités par les utilisateurs en raison de leur simplicité d’utilisation pour filtrer les données : en cliquant tout simplement sur un élément du segment.
Pour ceux qui ne les connaissent pas encore, précisons :

- qu’ils s’obtiennent en sélectionnant le tableau source, puis dans le menu « Création de tableau », choisir « Insérer un segment », Microsoft fournit une aide qui en dit plus ;

- qu’ils ne peuvent que filtrer les données égales à la sélection, et ne permettent pas d’avoir des conditions avancées, comme « contient », « plus petit que », etc., mais c’est justement cette simplicité que les utilisateurs apprécient ;

- que plusieurs éléments d’un segment peuvent être sélectionnés (en maintenant la touche [Ctrl] enfoncée lors du clic, ou en cliquant préalablement sur l’icône « Sélection multiple » du segment) ;

- que le filtre peut être effacé en cliquant sur l’icône « Effacer le filtre » du segment ;

- qu’ils s’appliquent aussi bien aux tableaux structurés qu’aux tableaux et graphiques croisés dynamiques.

Si les utilisateurs peuvent facilement ajouter manuellement des segments pour filtrer les données d’un tableau structuré, vous allez constater, dans cette documentation, que l’utilisation du VBA permettra aux développeurs d’en décupler les avantages…

C’est pourquoi nous allons étudier des fonctions en VBA qui permettent de gérer les segments : pour savoir s’ils existent, les créer, les déplacer, modifier certains de leurs paramètres, ou les supprimer.

Puis des fonctions qui permettent de gérer les éléments de ces segments : pour identifier ceux qui sont sélectionnés, déclencher ou inhiber leur sélection, et d’autres fonctions qui peuvent être bien utiles…

Nous verrons ensuite des exemples de mise en pratique de ces fonctions, et nous serons capables d’utiliser un segment pour masquer les colonnes (et non plus les lignes) d’un tableau structuré.

Il existe un second type de filtre, qui ne s’applique qu’aux tableaux et graphiques croisés dynamiques : les chronologies.
Les chronologies sont utilisées sur les dates pour filtrer une période, avec une échelle de temps qui peut être, au choix : les jours, les mois, les trimestres, les années.
La sélection de la période se fait en cliquant sur la barre de la chronologie. Elle peut être étendue en maintenant le clic enfoncé, ou avec la combinaison de touches [Ctrl]+[Majuscule].
Bien que les chronologies ne s’appliquent pas nativement aux tableaux structurés, nous verrons comment, grâce au VBA, nous pouvons filtrer les dates d’un tableau structuré avec une chronologie.

Un exemple de segments et de chronologie qui servira de fil rouge pour cette documentation :

Exemple de segments et d'une chronologie

Pour une meilleure ergonomie, je vous invite à configurer les paramètres des segments (cliquez sur le segment, puis dans le menu « Segment », choisissez « Paramètre des segments ») pour :
- afficher l’en-tête ;
- utiliser un tri croissant ;
- masquer les éléments sans données.

Vous trouverez d’autres configurations dans l’onglet « Segment » du ruban :

Pour figer la position et les dimensions du segment, faire un clic gauche dessus pour ouvrir le menu contextuel et cliquer sur « Taille et propriétés… » ; dans la mise en forme du segment, à la rubrique « Position et disposition » cocher « Désactiver le redimensionnement et le déplacement », et à la rubrique « Propriétés » cocher « Ne pas déplacer ou dimensionner avec les cellules ».
Voir la fonction SegmentFiger.

II - Utiliser les segments sur un tableau structuré

Nous allons distinguer les fonctions pour gérer les segments de celles pour gérer les éléments des segments.

II-1 - Fonctions pour gérer les segments

Avant de passer aux travaux pratiques, il est nécessaire de faire une présentation des fonctions, que vous trouverez dans le fichier joint et en annexe, qui permettent de gérer les segments. Nous ne détaillerons pas ici le code source en VBA.

II-1-A - SegmentExiste

La fonction SegmentExiste renseigne si un segment existe.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données, si vide la recherche porte sur NomColonne ;
• NomColonne : le nom de la colonne liée au segment, si vide la recherche porte sur NomTableau.

La fonction renvoie : True si le segment existe, False dans le cas contraire.

Exemple pour afficher un message si le segment « Prof » du tableau « TS_Eleves » n’existe pas :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentExiste()
'------------------------------------------------------------------------------------------------------
If SegmentExiste("TS_Eleves", "Prof") = False Then MsgBox "Le segment Prof doit être ajouté"
End Sub

II-1-B - SegmentCreer

La fonction SegmentCreer crée un segment pour un tableau.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• Cellule : un « Range » qui représente la cellule où sera placé le segment créé.

La fonction renvoie : True si le segment a été créé, False dans le cas contraire.

Exemple pour créer le segment « Prof » du tableau « TS_Eleves » et le placer en cellule « E2 » (dans la feuille du tableau) :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentCreer()
'------------------------------------------------------------------------------------------------------
Call SegmentCreer("TS_Eleves", "Prof", [E2])
End Sub

La largeur du segment est ajustée en se basant sur la largeur de la colonne source.
Les paramètres sont configurés pour : afficher l’en-tête ; utiliser un tri croissant ; masquer les éléments sans donnée.

II-1-C - SegmentStyle

La fonction SegmentStyle modifie le style (la couleur) d’un segment.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• NouveauStyle : l’une des 12 valeurs de l’énumération « SlicerCachesStyle », c’est-à-dire de « SlicerStyleLight1 » à « SlicerStyleLight6 » pour les 6 styles clairs, et de « SlicerStyleDark1 » à « SlicerStyleDark6 » pour les 6 styles foncés.

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

Exemple pour donner le style « SlicerStyleDark1 » au segment « Prof » du tableau « TS_Eleves » :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentStyle()
'------------------------------------------------------------------------------------------------------
Call SegmentStyle("TS_Eleves", "Prof", SlicerStyleDark1)
End Sub

II-1-D - SegmentBoutons

La fonction SegmentBoutons configure la dimension des boutons d’un segment.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• NbColonne : (optionnel) si différent de zéro, le nombre de boutons à afficher sur une ligne ;
• Hauteur : (optionnel) si différent de zéro, la hauteur (en points) des boutons du segment ;
• Largeur : (optionnel) si différent de zéro, la largeur (en points) des boutons du segment.

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

Exemple pour afficher deux boutons par ligne dans le segment « Salle » du tableau « TS_Eleves ». Les boutons ont une hauteur de 18,5 points et une largeur de 80 points :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentBoutons()
'------------------------------------------------------------------------------------------------------
Call SegmentBoutons("TS_Eleves", "Salle", 2,  18.5, 80)
End Sub

II-1-E - SegmentTaille

La fonction SegmentTaille configure la taille d’un segment.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• NbBouton : (optionnel) si différent de zéro, ajuste la hauteur du segment pour contenir le nombre de boutons indiqué dans cet argument ; si -1 est passé alors ajuste la hauteur du segment pour contenir tous les boutons ;
• Largeur : (optionnel) si différent de zéro, la largeur (en points) du segment.

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

Exemple pour ajuster la taille du segment « Prof » du tableau « TS_Eleves » pour afficher tous les boutons, avec une largeur de 120 points :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentTaille()
'------------------------------------------------------------------------------------------------------
Call SegmentTaille("TS_Eleves", "Prof", -1, 120)
End Sub

II-1-F - SegmentDeplacer

La fonction SegmentDeplacer déplace un segment sur une autre feuille (en conservant sa taille et certaines de ses propriétés).

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• NomFeuilleDestination : le nom de la feuille de destination.

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

Exemple pour déplacer le segment « Prof » du tableau « TS_Eleves » sur la feuille « Menu » (du classeur actif) :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentDeplacer()
'------------------------------------------------------------------------------------------------------
Call SegmentDeplacer("TS_Eleves", "Prof", "Menu")
End Sub

Il n’existe pas de méthode en VBA pour déplacer un segment. La solution de contournement est de le supprimer puis de le créer sur une autre feuille.
Manuellement, il faut copier le segment, le supprimer, le coller sur une autre feuille.

II-1-G - SegmentSupprimer

La fonction SegmentSupprimer supprime un segment.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment.

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

Exemple pour supprimer le segment « Prof » du tableau « TS_Eleves » :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentSupprimer()
'------------------------------------------------------------------------------------------------------
Call SegmentSupprimer("TS_Eleves", "Prof")
End Sub

II-1-H - SegmentEstFiltre

La fonction SegmentEstFiltre renseigne si un segment est filtré ou non.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment.

La fonction renvoie : True si le segment existe et est filtré, False dans le cas contraire.

Exemple pour savoir si le segment « Prof » du tableau « TS_Eleves » est filtré :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentEstFiltre()
'------------------------------------------------------------------------------------------------------
If SegmentEstFiltre("TS_Eleves", "Prof") = True Then MsgBox "Prof est filtré" Else MsgBox "Prof n'est pas filtré"
End Sub

II-1-I - SegmentFiger

La fonction SegmentFiger permet de figer la position d'un segment.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• Figer : True s'il faut figer la position et la dimension du segment, False s'il faut tout libérer ;
• Placement : la propriété du placement suivant l'énumération XlPlacement.

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

Exemple pour figer le segment « Salle » du tableau « TS_Eleves » :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentFiger()
'------------------------------------------------------------------------------------------------------
Call SegmentFiger("TS_Eleves", "Salle", True, xlFreeFloating)
End Sub

II-2 - Fonctions pour gérer les éléments d’un segment

Ce chapitre présente des fonctions qui servent à la gestion des éléments des segments.
Comme pour le chapitre précédent, l’objectif est de fournir des fonctionnalités qui pourront vous être utiles.
Nous ne détaillerons pas le code VBA, que vous retrouverez dans le fichier joint et en annexe.

II-2-A - SegmentElementExiste

La fonction SegmentElementExiste renseigne si un élément d’un segment existe.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• Item : le nom de l’élément du segment.

La fonction renvoie : True si l’élément existe, False dans le cas contraire.

Exemple pour afficher un message si l’élément « DUPOND » n’existe pas dans le segment « Prof » du tableau « TS_Eleves » :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentElementExiste()
'------------------------------------------------------------------------------------------------------
If SegmentElementExiste("TS_Eleves", "Prof", "DUPOND") = False Then MsgBox "Le prof DUPOND n'existe pas"
End Sub

II-2-B - SegmentCompterElements

La fonction SegmentCompterElements renvoie le nombre d’éléments d’un segment.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• QueLesActifs : si True alors ne compte que les éléments sélectionnés et avec des données, si False alors compte tous les éléments du segment.

La fonction renvoie : suivant la valeur de l’argument « QueLesActifs », soit le nombre d’éléments sélectionnés et avec des données, soit le nombre total d’éléments du segment.

Exemple pour afficher le nombre d’éléments des segments « Prof » et « Salle » du tableau « TS_Eleves » :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentCompterElements()
'------------------------------------------------------------------------------------------------------
MsgBox "Il y a " & SegmentCompterElements("TS_Eleves", "Prof", False) _
& " profs et " & SegmentCompterElements("TS_Eleves", "Salle", False) _
& " salles."
End Sub

II-2-C - SegmentListeElements

La fonction SegmentListeElements renvoie la liste, en base 1, des éléments d’un segment.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• QueLesActifs : si True alors ne traite que les éléments sélectionnés et avec des données, si False alors traite tous les éléments du segment.

La fonction renvoie une liste en base 1 : suivant la valeur de l’argument « QueLesActifs », soit les éléments sélectionnés et avec des données, soit tous les éléments du segment.

Exemple pour afficher en cellule « C6 » les éléments sélectionnés du segment « Prof » du tableau « TS_Eleves », séparés par une virgule :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentListeElements()
'------------------------------------------------------------------------------------------------------
Dim Prof
Prof = SegmentListeElements("TS_Eleves", "Prof", True)
Range("C6") = Join(Prof, ", ")
End Sub

II-2-D - SegmentActiverUnElement

La fonction SegmentActiverUnElement active (sélectionne) un élément d’un segment, sans désactiver les éventuels éléments déjà activés.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• Item : le nom de l’élément du segment à activer.

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

Exemple pour activer l’élément « DURAND » du segment « Prof » du tableau « TS_Eleves » :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentActiverUnElement()
'------------------------------------------------------------------------------------------------------
Call SegmentActiverUnElement("TS_Eleves", "Prof", "DURAND")
End Sub

II-2-E - SegmentActiverListeElements

La fonction SegmentActiverListeElements active (sélectionne) un ou plusieurs éléments d’un segment, et désactive les autres éléments qui ne sont pas dans la liste.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• ListeItems : la liste des éléments à activer. S'il y en a plusieurs alors passer un Array. Si vide alors active tous les éléments.

La fonction renvoie : le nombre d'éléments sélectionnés, ou 0 si tout est sélectionné.

Exemple pour activer tous les éléments du segment « Prof », puis les éléments « Jaune » et « Verte » du segment « Salle », du tableau « TS_Eleves » :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentActiverListeElements()
'------------------------------------------------------------------------------------------------------
Call SegmentActiverListeElements("TS_Eleves", "Prof", "")
Call SegmentActiverListeElements("TS_Eleves", "Salle", Array("Jaune", "Verte"))
End Sub

II-2-F - SegmentElementEstActif

La fonction SegmentElementEstActif renseigne si un élément d’un segment est actif (sélectionné) ou pas.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• Item : le nom de l'élément.

La fonction renvoie : True si l’élément est actif (même s’il n’a pas de donnée), False s’il ne l’est pas.

Exemple pour afficher un message indiquant si l'élément « DURAND » du segment « Prof » est activé ou non :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentElementEstActif()
'------------------------------------------------------------------------------------------------------
MsgBox "Le prof DURAND " _
& IIf(SegmentElementEstActif("TS_Eleves", "Prof", "DURAND") = True, "est", "n'est pas")
& " sélectionné."
End Sub

II-2-G - SegmentEstAvecDonnees

La fonction SegmentEstAvecDonnees renseigne si un élément d’un segment a des données ou pas.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• Item : le nom de l'élément.

La fonction renvoie : True si l’élément a des données, False s’il n'en a pas.

Exemple pour activer uniquement l'élément « Jaune » du segment « Salle », puis afficher un message indiquant si l'élément « DURAND » du segment « Prof » a des données ou non :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentEstAvecDonnees()
'------------------------------------------------------------------------------------------------------
Call SegmentActiverListeElements("TS_Eleves", "Salle", "Jaune")
MsgBox "Le prof DURAND " _
& IIf(SegmentEstAvecDonnees("TS_Eleves", "Prof", "DURAND") = True, "a des élèves.", "n'a pas d'élève") _
& " dans la salle jaune."
End Sub

II-2-H - SegmentDesactiverUnElement

La fonction SegmentDesactiverUnElement désactive un élément d’un segment, sans désactiver les autres éléments sélectionnés. Si plus aucun élément n'est sélectionné, alors tous sont sélectionnés.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment ;
• Item : le nom de l'élément.

La fonction renvoie : True si l’élément a été désactivé, False dans le cas contraire.

Exemple pour activer tous les éléments du segment « Salle » sauf l'élément « Jaune » :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentDesactiverUnElement()
'------------------------------------------------------------------------------------------------------
Call SegmentActiverListeElements("TS_Eleves", "Salle", "")
Call SegmentDesactiverUnElement("TS_Eleves", "Salle", "Jaune")
End Sub

II-2-I - SegmentEffacerTousLesFiltres

La fonction SegmentEffacerTousLesFiltres efface les filtres, soit des segments du tableau passé en argument, soit de tous les segments du classeur actif si l’argument n’est pas renseigné.

Son argument (sensible à la casse) est :
• NomTableau : (facultatif) le nom du tableau qui contient les données.

La fonction renvoie : True si au moins un segment est traité, False dans le cas contraire.

Exemple pour effacer les filtres de tous les segments liés au tableau « TS_Eleves » :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentEffacerTousLesFiltres()
'------------------------------------------------------------------------------------------------------
Call SegmentEffacerTousLesFiltres("TS_Eleves")
End Sub

II-2-J - SegmentSaisirSelection

La fonction SegmentSaisirSelection ouvre une boîte de saisie pour permettre à l'utilisateur de saisir un mot clé afin d'activer un ou plusieurs éléments dans un segment, qui correspondent à ce mot clé.

Vous pouvez utiliser les jokers :
* (étoile) pour remplacer plusieurs caractères ;
? (point d'interrogation) pour remplacer un caractère.

Si aucun élément n'est trouvé, la recherche sera relancée sans respecter la casse et avec le joker « étoile » au début et en fin du mot clé.
Si malgré cette seconde recherche aucun élément n’est trouvé, la sélection active n’est pas modifiée.

Ses arguments (sensibles à la casse) sont :
• NomTableau : le nom du tableau qui contient les données ;
• NomColonne : le nom de la colonne liée au segment.

La fonction renvoie : True si au moins un élément est activé suite à cette recherche, False dans le cas contraire.

Exemple pour inviter l’utilisateur à faire une sélection sur le segment « Salle » :

'------------------------------------------------------------------------------------------------------
Sub Démo_SegmentSaisirSelection()
'------------------------------------------------------------------------------------------------------
Call SegmentSaisirSelection("TS_Eleves", "Salle")
End Sub

S’il saisit « V* », les salles « Verte » et « Violette » sont sélectionnées.
S’il saisit « v », aucun élément ne répondant à la demande, la recherche est relancée sur « *v* » sans tenir compte de la casse, ce qui sélectionne les salles « Verte » et « Violette ».
De même, s’il saisit « vert », la salle « Verte » est sélectionnée, après transformation du mot clé en « *vert* ».

Vous pouvez lancer cette fonction depuis un bouton de commande placé en haut du segment, en lui associant une macro (qui contient par exemple Call SegmentSaisirSélection("TS_Eleves", "Salle") )

II-3 - Exemples de gestion des éléments d’un segment

Vous pouvez ajouter un bouton de commande qui efface, via une macro, les filtres des deux segments « Prof » et « Salle » :

'------------------------------------------------------------------------------------------------------
Sub Démo_AfficherTout()
'------------------------------------------------------------------------------------------------------
Call SegmentEffacerTousLesFiltres("TS_Eleves")
End Sub

Ou bien, sélectionner les éléments qui commencent par « V » dans le segment « Salle » :

'------------------------------------------------------------------------------------------------------
Sub Démo_Afficher_Salle_V()
'------------------------------------------------------------------------------------------------------
Dim i As Integer, Salle

' Affiche toutes les données des deux segments:
Call SegmentEffacerTousLesFiltres("TS_Eleves")

' Mémorise les éléments du segment "Salle" :
Salle = SegmentListeElements("TS_Eleves", "Salle", False)

' Boucle pour désactiver les éléments qui ne commencent pas par V:
For i = 1 To UBound(Salle)
If Not Salle(i) Like "V*" Then Call SegmentDesactiverUnElement("TS_Eleves", "Salle", Salle(i))
Next i

End Sub

Dans les chapitres qui suivent, nous allons voir d’autres exemples de gestion des éléments d’un segment en VBA qui interceptent un changement et agissent en conséquence.

II-4 - Capter un changement de sélection dans un segment lié à un tableau structuré

Les ingénieurs de Microsoft n’ont pas eu la bonne idée de mettre à la disposition des développeurs un évènement déclenché lorsqu’une sélection change dans un segment lié à un tableau structuré. Pour capter un tel changement, la solution de contournement est de mettre une formule sur la feuille, et d’appliquer un évènement lors de son calcul : Worksheet_Calculate().
L’évènement va alors lancer une fonction personnelle, placée dans un module classique, qui va gérer ce changement.

Dans notre exemple, une formule dans la colonne « Actif » du tableau structuré permet d’afficher « 1 » si la ligne est visible (donc sélectionnée par un élément du segment), et « 0 » lorsqu’elle n’est pas visible (donc non sélectionnée) : =SOUS.TOTAL(103; [@Salle])

Ce qui permet, d’une part, d’alimenter en temps réel le tableau de bord qui contient des formules pour traiter les données des lignes visibles uniquement (donc sélectionnées par les segments) :

Et d’autre part, d’afficher la liste des profs sélectionnés, grâce à la fonction Démo_MiseAJour_TableauDeBord, lancée quand la feuille est calculée suite à un changement de sélection des éléments.

La procédure évènementielle de la feuille :

'------------------------------------------------------------------------------------------------------
Private Sub Worksheet_Calculate()
'------------------------------------------------------------------------------------------------------
Call Démo_MiseAJour_TableauDeBord
End Sub

La procédure personnelle dans un module de programmation :

'------------------------------------------------------------------------------------------------------
Sub Démo_MiseAJour_TableauDeBord()
'------------------------------------------------------------------------------------------------------
' Affiche en "C6" les éléments actifs du segment "Prof":
Dim Prof
Prof = SegmentListeElements("TS_Eleves", "Prof", True)
Range("C6") = Join(Prof, ", ")
End Sub

Le tableau structuré TS_Eleves, ses segments et son tableau de bord

Complétons cette fonction pour changer le style du segment « Prof » lorsque tous les éléments sont sélectionnés :

'------------------------------------------------------------------------------------------------------
Sub Démo_MiseAJour_TableauDeBord()
'------------------------------------------------------------------------------------------------------
Dim Prof

' Affiche en "C6" les éléments actifs du segment "Prof":
Prof = SegmentListeElements("TS_Eleves", "Prof", True)
Range("C6") = Join(Prof, ", ")

' Couleur du segment "Prof" en vert foncé si tous les prof sont sélectionnés, sinon en bleu clair:
If SegmentEstFiltre("TS_Eleves", "Prof") = False Then
Call SegmentStyle("TS_Eleves", "Prof", SlicerStyleDark6)
Else
Call SegmentStyle("TS_Eleves", "Prof", SlicerStyleLight1)
End If

End Sub

Un segment peut avoir plusieurs éléments sélectionnés, mais il est possible de contourner cette possibilité de sélection multiple, si vous souhaitez restreindre la sélection à un seul élément.
Ce code, ajouté à la fonction Démo_MiseAJour_TableauDeBord ci-dessus, ne retient la sélection que d’un seul élément dans le segment « Salle », même si plusieurs ont été sélectionnés :

Dim Salle
Salle = SegmentListeElements("TS_Eleves", "Salle", True)
If UBound(Salle) > 1 Then
Application.EnableEvents = False
Call SegmentActiverListeElements("TS_Eleves", "Salle", Salle(1))
Application.EnableEvents = True
End If

L’exercice suivant consiste à ajouter un segment contenant une liste de colonnes du tableau structuré « TS_Eleves », que nous choisirons d’afficher ou non :
- Dans une nouvelle feuille, renseignez une plage contenant le titre « Colonnes à afficher », et les noms des colonnes souhaitées : « Prénom », « Commentaire », « Genre » ; sans oublier le choix « Aucune » (si l’on souhaite donner la possibilité de masquer les trois colonnes).
- Sélectionnez la plage pour la transformer en un tableau (structuré) que vous renommerez « TS_Afficher ».
- Ajoutez-y une ligne de total (pour générer un calcul en cas de sélection et ainsi déclencher un évènement qui sera capté) ; dans la liste déroulante choisissez « Nombre ».
- Insérez un segment sur la colonne « Colonnes à afficher » et le code suivant pour la procédure évènementielle de la feuille :

'------------------------------------------------------------------------------------------------------
Private Sub Worksheet_Calculate()
'------------------------------------------------------------------------------------------------------
' Suivant les éléments sélectionnés de "TS_Afficher", affiche ou masque les colonnes de "TS_Eleves":
Call SegmentMasquerAfficherColonneTS("TS_Afficher", "TS_Eleves")

' Si plusieurs sélections sont faites alors l’élément "Aucune" ne doit pas être sélectionné:
If SegmentCompterElements("TS_Afficher", "", True) > 1 Then
Application.EnableEvents = False
Call SegmentDesactiverUnElement("TS_Afficher", "", "Aucune")
Application.EnableEvents = True
End If

End Sub

- Enfin, déplacez le segment sur la feuille du tableau « TS_Eleves ».

Le tableau « TS_Afficher » a été généré sur une autre feuille qui sera masquée par la suite afin de ne pas perturber l’utilisateur, mais il aurait pu être généré directement sur la feuille du tableau « TS_Eleves ».

La fonction SegmentMasquerAfficherColonneTS a comme arguments (sensibles à la casse) :
• TSSegment : le nom du tableau structuré qui contient les données du segment ;
• NomTableau : le nom du tableau structuré dont il faut masquer ou afficher les colonnes.

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

La liste des éléments de notre segment « Colonne à afficher » peut être affichée dans un ordre personnalisé et non plus par ordre alphabétique :
Sélectionnez le tableau structuré « TS_Afficher » puis le menu « Données / Trier ». Dans le champ « Ordre » piochez « Liste personnalisée… ».
Dans la colonne « Entrées de la liste » saisissez les éléments dans l’ordre que vous souhaitez les voir dans le segment, cliquez sur « Ajouter » puis « OK ».
N’oubliez pas de modifiez les paramètres du segment pour activer l’option « Utiliser des listes personnalisées lors du tri ».

III - Utiliser une chronologie sur un tableau structuré

Comme évoqué en introduction, les chronologies ne s’appliquent pas aux tableaux structurés, mais uniquement aux tableaux et graphiques croisés dynamiques (et aux cubes).
Pour s’en servir sur un tableau structuré, nous allons utiliser une astuce que je trouve élégante et familière aux utilisateurs : en générant un tableau croisé dynamique (TCD) dont la source est la colonne de dates du tableau structuré, y insérer une chronologie, et capter les actions effectuées sur la chronologie pour filtrer le tableau structuré.
Par convention, nous n’utiliserons qu’une seule chronologie par TCD.

III-1 - Fonctions pour gérer les chronologies

Dans un premier temps, commençons par présenter les fonctions que vous trouverez dans le fichier joint et en annexe, qui nous permettent de gérer les chronologies.

III-1-A - ChronologieExiste

La fonction ChronologieExiste renseigne si une chronologie existe.

Son argument (sensible à la casse) est :
• NomTCD : le nom du tableau croisé dynamique qui contient les données.

La fonction renvoie : True si la chronologie existe, False dans le cas contraire.

Exemple pour afficher un message si la chronologie du TCD nommé « TCD_Dates » n’existe pas  :

'------------------------------------------------------------------------------------------------------
Sub Démo_ChronologieExiste()
'------------------------------------------------------------------------------------------------------
If ChronologieExiste("TCD_Dates") = False Then MsgBox "TCD_Dates et sa chronologie doivent être ajoutés"
End Sub

III-1-B - ChronologieStyle

La fonction SegmeChronologieStylentCreer modifie le style (la couleur) d’une chronologie.

Ses arguments (sensibles à la casse) sont :
• NomTCD : le nom du tableau croisé dynamique qui contient les données ;
• NouveauStyle : l’une des 12 valeurs de l’énumération « SlicerCachesStyle », c’est-à-dire de « SlicerStyleLight1 » à « SlicerStyleLight6 » pour les 6 styles clairs, et de « SlicerStyleDark1 » à « SlicerStyleDark6 » pour les 6 styles foncés.

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

Exemple pour donner le style « SlicerStyleDark1 » à la chronologie du TCD nommé « TCD_Dates » :

'------------------------------------------------------------------------------------------------------
Sub Démo_ChronologieStyle()
'------------------------------------------------------------------------------------------------------
Call ChronologieStyle("TCD_Dates", SlicerStyleDark1)
End Sub

III-1-C - ChronologieTaille

La fonction ChronologieTaille configure la taille d’une chronologie.

Ses arguments (sensibles à la casse) sont :
• NomTCD : le nom du tableau croisé dynamique qui contient les données ;
• Hauteur : (optionnel) si différent de zéro, la hauteur (en points) de la chronologie ;
• Largeur : (optionnel) si différent de zéro, la largeur (en points) de la chronologie.

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

Exemple pour modifier la taille de la chronologie du TCD nommé « TCD_Dates » :

'------------------------------------------------------------------------------------------------------
Sub Démo_ChronologieTaille()
'------------------------------------------------------------------------------------------------------
Call ChronologieTaille("TCD_Dates", 100, 260)
End Sub

III-1-D - ChronologieInfos

La fonction ChronologieInfos renvoie des informations sur les filtres d’une chronologie.

Ses arguments (sensibles à la casse) sont :
• NomTCD : le nom du tableau croisé dynamique qui contient les données ;
• Début : (optionnel) date de début de la chronologie ;
• FiltreMini : (optionnel) date de début du filtre de la chronologie ;
• FiltreMaxi : (optionnel) date de fin du filtre de la chronologie ;
• Fin : (optionnel) date de fin de la chronologie.

La fonction renvoie : True si la chronologie est filtrée, False dans le cas contraire.

Elle renseigne les variables de dates passées en arguments.

Exemple pour afficher les dates de filtres de la chronologie du TCD nommé « TCD_Dates » :

'------------------------------------------------------------------------------------------------------
Sub Démo_ChronologieInfos()
'------------------------------------------------------------------------------------------------------
Dim Début, Mini, Maxi, Fin
If ChronologieInfos("TCD_Dates", Début, Mini, Maxi, Fin) = True Then
MsgBox "Filtres de la chronologie : " & Mini & " à " & Maxi
Else
MsgBox "La chronologie n’est pas filtrée. Plage = " & Début & " à " & Fin
End If
End Sub

Les dates de la chronologie sont en lecture seule. Vous ne pouvez donc pas modifier directement le filtre de la chronologie en modifiant ces dates. Pour cela, utilisez la fonction ChronologieFiltrer.
Lorsqu’il n’y a aucun filtre sur la chronologie une erreur est levée. Dans ce cas, la fonction ChronologieInfos renvoie False, et les dates sont renseignées en analysant le TCD source.

III-1-E - ChronologieFiltrer

La fonction ChronologieFiltrer pose les filtres d’une chronologie.

Ses arguments (sensibles à la casse) sont :
• NomTCD : le nom du tableau croisé dynamique qui contient les données ;
• FiltreMini : la date de début du filtre de la chronologie ;
• FiltreMaxi : la date de fin du filtre de la chronologie.

La fonction renvoie : True si le filtre de la chronologie est réalisé, False dans le cas contraire (par exemple si les dates ne sont pas cohérentes).

Exemple pour filtrer la chronologie liée au TCD nommé « TCD_Dates » entre aujourd’hui et le 31 décembre 2029 :

'------------------------------------------------------------------------------------------------------
Sub Démo_ChronologieFiltrer()
'------------------------------------------------------------------------------------------------------
Call ChronologieFiltrer("TCD_Dates", Date, "31/12/2029")
End Sub

III-1-F - ChronologieEffacer

La fonction ChronologieEffacer efface les filtres, soit de la chronologie liée au nom du TCD passé en argument, soit de toutes les chronologies du classeur actif si l’argument n’est pas renseigné.

Son argument (sensible à la casse) est :
• NomTCD : (facultatif) le nom du tableau croisé dynamique qui contient les données.

La fonction renvoie : True si au moins une chronologie est traitée, False dans le cas contraire.

III-1-G - ChronologieActualiser

La fonction ChronologieActualiser actualise, soit la chronologie liée au nom du TCD passé en argument, soit toutes les chronologies du classeur actif si l’argument n’est pas renseigné.

Son argument (sensible à la casse) est :
• NomTCD : (facultatif) le nom du tableau croisé dynamique qui contient les données.

La fonction renvoie : True si au moins une chronologie (et son TCD) est actualisée, False dans le cas contraire.

III-2 - Capter un changement de sélection dans une chronologie liée à un TCD

Contrairement aux tableaux structurés, les tableaux croisés dynamiques (TCD) disposent d’un évènement déclenché lors d’une modification de filtre d’un TCD :
L’évènement de la feuille Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable).
Et c’est bien utile, car la chronologie étant liée au TCD, une modification du filtre de la chronologie va modifier le filtre du TCD, et cette modification déclenche la procédure évènementielle.
On y placera la fonction ChronologieLiaisonsTCD qui se chargera de retrouver le tableau structuré lié au TCD et la colonne concernée, pour y poser les filtres équivalents aux filtres de la chronologie.

L’exercice consiste à ajouter une chronologie pour filtrer la colonne « Dates » du tableau structuré « TS_Eleves » :
- Dans une nouvelle feuille (nommée par exemple « TCD_Dates »), insérez un TCD lié à la colonne « Dates » du tableau « TS_Eleves », menu « Insertion » / « Tableau croisé dynamique » / « A partir d’un tableau ou d’une plage ».
- Renseignez la source et la destination :

- Renommez le TCD en « TCD_Dates ».
- Sélectionnez le champ « Dates » pour constituer le TCD :

- Dans les « Options du tableau croisé dynamique », dans l’onglet « Données », à la rubrique « Nombre d’éléments à retenir par champ », choisissez « Aucun » (ce qui permettra d’avoir une chronologie qui ne reprend que les données actives en cas de suppression de données).
- Insérez une chronologie depuis le menu « Analyse du tableau croisé dynamique » et le code suivant pour la procédure évènementielle de la feuille :

'------------------------------------------------------------------------------------------------------
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'------------------------------------------------------------------------------------------------------
Call ChronologieLiaisonsTCD(Target.Name)
End Sub

- Enfin, déplacez la chronologie sur la feuille du tableau « TS_Eleves » par un copier-supprimer-coller.

Pour une meilleure ergonomie, je vous invite à ne pas afficher la barre de défilement de la chronologie :

Et à lui affecter la fonction ChronologieAnnulerSélection qui ne contient aucun code ! Ça permet juste d’éviter de sélectionner la chronologie lors d’un clic gauche dessus : clic droit sur la chronologie / « Affecter une macro… », sélectionnez la fonction ChronologieAnnulerSélection.

Nous avons vu qu’une chronologie et son TCD sont liés.
Dans notre exemple, le tableau structuré « TS_Eleves » n’est pas lié au tableau croisé dynamique « TCD_Dates », et la modification ou l’ajout de données dans « TS_Eleves » ne se répercute donc pas dans « TCD_Dates » : la chronologie n’est alors pas mise à jour.
Nous allons y remédier…

• Si vous disposez d’une version d’Excel qui possède l’option « Renouvellement automatique », pensez à l’activer pour mettre à jour le TCD lors d’une modification ou d’un ajout de ligne dans le tableau structuré source :

• Sinon, il faut ajouter une procédure évènementielle sur la feuille du tableau structuré, pour capter une saisie, et la fonction ChronologieLiaisonsTS comme dans cet exemple :

'------------------------------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'------------------------------------------------------------------------------------------------------
Call ChronologieLiaisonsTS("TS_Eleves")
End Sub

• Ou demander à l’utilisateur de cliquer sur le bouton « Actualiser tout » du menu « Données ».

IV - Démonstration

Dans les chapitres précédents, nous avons étudié les principes de base de la gestion en VBA des segments et des chronologies.
Le fichier joint présente une démonstration de leur usage qui, j’espère, vous convaincra de la puissance ces technologies.

La feuille « TS_Commandes » contient une liste de commandes identifiées par un numéro de commande, un fournisseur, un type de produit, et la quantité commandée. Le but est de suivre les facturations reçues, à imputer à ces commandes, et le reste à recevoir.

Les segments permettent de filtrer les commandes, pour des analyses rapides.

La feuille « TS_Saisie » est utilisée pour imputer aux commandes les factures reçues.
Les segments servent à identifier la commande concernée, d’après son numéro, le fournisseur, le produit (l’ordre de sélection est libre bien entendu) :

Quand l’identification de la commande est faite (sélection d’un seul numéro de commande, d’un seul fournisseur, d’un seul produit), le bouton « Prendre cette commande » alimente le tableau de gauche des informations et place le curseur dans la colonne « Quantité » qu’il reste à saisir :

La facture peut comporter plusieurs lignes. Le bouton « Valider la saisie » enregistre les données sur la feuille « TS_Factures », et efface le tableau pour permettre une nouvelle saisie.

Une notification générée par PoweShell s’affiche quelques secondes pour informer l’utilisateur du traitement de sa saisie.

La feuille « TS_Factures » contient également des segments et une chronologie pour filtrer les factures :

Les filtres effectués sur cette feuille se répercutent sur la feuille des commandes, y compris la chronologie :

V - Conclusion

Ce n’est pas par hasard si les utilisateurs apprécient les segments et les chronologies, car leur ergonomie simplifie grandement la sélection des données : il est bien plus facile, et rapide, de cliquer sur un élément d’un segment que de passer par les filtres d’un tableau (qui restent disponibles pour les requêtes plus complexes).
Idem pour la chronologie qui permet de sélectionner facilement une période et une échelle de temps de son choix.

Les fonctions en VBA étudiées dans cette documentation vous permettront d’intégrer ces technologies dans vos projets.
Vous en trouverez le code source dans le fichier joint et en annexe.

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

Bonne programmation.
Laurent OTT.
2026.

VI - Remerciements

Je remercie f-leb pour sa correction orthographique.
Ainsi que toute l’équipe de Developpez.com qui participe à la maintenance du site.

VII - Le fichier joint

Vous trouverez le fichier Segments.xlsm qui contient les fonctions étudiées dans cette documentation regroupées dans le module « Segments » facilement exportable dans vos applications par un simple « glisser-copier » depuis l’explorateur de projet VBA.
Le module « TS » reprend les fonctions de cette documentation : Fonctions en VBA pour gérer les Tableaux Structurés d'Excel.

VIII - Annexe - Le code source

Pour ceux qui ne peuvent pas télécharger le fichier source, cliquez sur « Afficher le code » :

'------------------------------------------------------------------------------------------------------
Option Explicit

Public Enum SlicerCachesStyle
SlicerStyleLight1
SlicerStyleLight2
SlicerStyleLight3
SlicerStyleLight4
SlicerStyleLight5
SlicerStyleLight6
SlicerStyleDark1
SlicerStyleDark2
SlicerStyleDark3
SlicerStyleDark4
SlicerStyleDark5
SlicerStyleDark6
End Enum

Private Sc As SlicerCache
Private SegmentNuméro As Integer

'------------------------------------------------------------------------------------------------------
Function SegmentSelectionNumero(NuméroSegment)
'------------------------------------------------------------------------------------------------------
SegmentNuméro = NuméroSegment
End Function
'------------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------------
Function SegmentExiste(NomTableau As String, NomColonne As String) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données qui sont filtrées par le segment.
' NomColonne : le nom de la colonne du segment.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si le segment existe et renseigne Sc.
'------------------------------------------------------------------------------------------------------
If SegmentNuméro = 0 Then SegmentNuméro = 1

For Each Sc In ActiveWorkbook.SlicerCaches
Select Case Sc.SlicerCacheType
Case 0 ' TS
If (Sc.ListObject.Name = NomTableau Or NomTableau = "") And (Sc.SourceName = NomColonne Or NomColonne = "") Then
If SegmentNuméro <= Sc.Slicers.Count Then SegmentExiste = True
Exit For
End If
Case xlSlicer ' 1 = TCD
If (Sc.PivotTables.Item(1).Name Or NomTableau = "") And (Sc.SourceName = NomColonne Or NomColonne = "") Then
If SegmentNuméro <= Sc.Slicers.Count Then SegmentExiste = True
Exit For
End If
End Select
Next Sc

End Function

'------------------------------------------------------------------------------------------------------
Function SegmentCreer(NomTableau As String, NomColonne As String, Cellule As Range) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données qui sont filtrées par le segment.
' NomColonne : le nom de la colonne du segment.
' Cellule : la cellule où placer le segment créé.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si le segment est créé.
'------------------------------------------------------------------------------------------------------
Dim W As Double, H As Double

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

' Si le segment existe déjà alors ne pas le créer:
If SegmentExiste(NomTableau, NomColonne) = True Then Exit Function

' Largeur du segment = largeur de la colonne source:
W = Range(NomTableau).ListObject.ListColumns(NomColonne).DataBodyRange.Width + 20
H = 100

' Création du nouveau segment sur la feuille du TS et renvoie VRAI si tout se passe bien:
Call ActiveWorkbook.SlicerCaches.Add2(Sheets(Range(NomTableau).ListObject.Parent.Name).ListObjects(NomTableau), NomColonne).Slicers.Add(Sheets(Range(NomTableau).ListObject.Parent.Name), , NomColonne, NomColonne, Cellule.Top, Cellule.Left, W, H)

' Modification de la hauteur et de certains paramètres:
If SegmentExiste(NomTableau, NomColonne) = True Then
With Sc.Slicers(1)
H = .SlicerCache.SlicerItems.Count  ' Nombre d'éléments.
H = H * (.RowHeight + 4) + 26       ' Hauteur approximative.
If H > 200 Then H = 200             ' Limite à 200.
.Height = H
.DisplayHeader = True
.SlicerCache.CrossFilterType = xlSlicerCrossFilterHideButtonsWithNoData
.SlicerCache.SortItems = xlSlicerSortAscending
.SlicerCache.SortUsingCustomLists = False
End With
SegmentCreer = True
On Error Resume Next
ActiveCell.Select
Err.Clear
End If

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

End Function

'------------------------------------------------------------------------------------------------------
Function SegmentStyle(NomTableau As String, NomColonne As String, NouveauStyle As SlicerCachesStyle) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données qui sont filtrées par le segment.
' NomColonne : le nom de la colonne du segment.
' NouveauStyle : l'une des 12 valeurs de l'énumération "SlicerCachesStyle"
'------------------------------------------------------------------------------------------------------
' Renvoie : True si style est appliqué.
'------------------------------------------------------------------------------------------------------
Dim CachesStyle
CachesStyle = Array("SlicerStyleLight1", "SlicerStyleLight2", "SlicerStyleLight3" _
, "SlicerStyleLight4", "SlicerStyleLight5", "SlicerStyleLight6" _
, "SlicerStyleDark1", "SlicerStyleDark2", "SlicerStyleDark3" _
, "SlicerStyleDark4", "SlicerStyleDark5", "SlicerStyleDark6")

If SegmentExiste(NomTableau, NomColonne) = True Then
Sc.Slicers(SegmentNuméro).Style = CachesStyle(NouveauStyle)
SegmentStyle = True
End If

End Function

'------------------------------------------------------------------------------------------------------
Function SegmentBoutons(NomTableau As String, NomColonne As String, _
Optional NbColonne As Byte = 0, _
Optional Hauteur As Double = 0, _
Optional Largeur As Double = 0) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données.
' NomColonne : le nom de la colonne du segment.
' NbColonne : si différent de zéro, le nombre de boutons à afficher sur une ligne.
' Hauteur : si différent de zéro, la hauteur (en points) des boutons du segment.
' Largeur : si différent de zéro, la largeur (en points) des boutons du segment.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim Figer As Boolean
If SegmentExiste(NomTableau, NomColonne) = True Then
Figer = Sc.Slicers(SegmentNuméro).DisableMoveResizeUI
Sc.Slicers(SegmentNuméro).DisableMoveResizeUI = False
If NbColonne <> 0 Then Sc.Slicers(SegmentNuméro).NumberOfColumns = NbColonne
If Hauteur <> 0 Then Sc.Slicers(SegmentNuméro).RowHeight = Hauteur
If Largeur <> 0 Then Sc.Slicers(SegmentNuméro).ColumnWidth = Largeur
Sc.Slicers(SegmentNuméro).DisableMoveResizeUI = Figer
ActiveCell.Select
SegmentBoutons = True
End If

End Function

'------------------------------------------------------------------------------------------------------
Function SegmentTaille(NomTableau As String, NomColonne As String, _
Optional ByVal NbBouton As Double = 0, _
Optional Largeur As Double = 0) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données.
' NomColonne : le nom de la colonne du segment.
' NbBouton : si différent de zéro, ajuste la hauteur du segment pour contenir le nombre de boutons indiqués dans cet argument.
'            si -1 est passé alors ajuste la hauteur du segment pour contenir tous les boutons.
' Largeur : si différent de zéro, la largeur (en points) du segment.
'------------------------------------------------------------------------------------------------------
Dim Figer As Boolean
If SegmentExiste(NomTableau, NomColonne) = True Then
Figer = Sc.Slicers(SegmentNuméro).DisableMoveResizeUI
Sc.Slicers(SegmentNuméro).DisableMoveResizeUI = False
If NbBouton > 0 Then
NbBouton = NbBouton * (Sc.Slicers(SegmentNuméro).RowHeight + 4) + 26
Sc.Slicers(SegmentNuméro).Height = NbBouton
End If
If NbBouton = -1 Then
NbBouton = Sc.SlicerItems.Count * (Sc.Slicers(SegmentNuméro).RowHeight + 4) + 26
Sc.Slicers(SegmentNuméro).Height = NbBouton
End If
If Largeur <> 0 Then Sc.Slicers(SegmentNuméro).Width = Largeur
Sc.Slicers(SegmentNuméro).DisableMoveResizeUI = Figer
ActiveCell.Select
SegmentTaille = True
End If

End Function

'------------------------------------------------------------------------------------------------------
Function SegmentDeplacer(NomTableau As String, NomColonne As String, NomFeuilleDestination As String) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données.
' NomColonne : le nom de la colonne du segment.
' NomFeuilleDestination : le nom de la feuille de destination.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim wsDest As Worksheet
Dim TopPos As Double, LeftPos As Double, W As Double, H As Double
Dim Anc_DisplayHeader As Boolean
Dim Anc_CrossFilterType As Long
Dim Anc_SortItems As Long
Dim Anc_SortUsingCustomLists As Variant
Dim AncStyle As Variant
Dim AncNbColonne As Integer
Dim AncHauteurBouton As Double
Dim AncEnableEvents As Long

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

' Feuille de destination:
Set wsDest = ActiveWorkbook.Worksheets(NomFeuilleDestination)

If SegmentExiste(NomTableau, NomColonne) = True Then

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

' Mémorise la configuration du segment puis le supprime:
With Sc.Slicers(SegmentNuméro)
TopPos = .Top
LeftPos = .Left
W = .Width
H = .Height
Anc_DisplayHeader = .DisplayHeader
Anc_CrossFilterType = .SlicerCache.CrossFilterType
Anc_SortItems = .SlicerCache.SortItems
Anc_SortUsingCustomLists = .SlicerCache.SortUsingCustomLists
AncStyle = .Style
AncNbColonne = .NumberOfColumns
AncHauteurBouton = .RowHeight
.Delete
End With

' Créer le nouveau segment sur la feuille destination:
Call ActiveWorkbook.SlicerCaches.Add2(Sheets(Range(NomTableau).ListObject.Parent.Name).ListObjects(NomTableau), NomColonne).Slicers.Add(Sheets(NomFeuilleDestination), , NomColonne, NomColonne, TopPos, LeftPos, W, H)

' Y place l'ancienne configuration:
If SegmentExiste(NomTableau, NomColonne) = True Then
With Sc.Slicers(SegmentNuméro)
.DisplayHeader = Anc_DisplayHeader
.SlicerCache.CrossFilterType = Anc_CrossFilterType
.SlicerCache.SortItems = Anc_SortItems
.SlicerCache.SortUsingCustomLists = Anc_SortUsingCustomLists
.Style = AncStyle
.NumberOfColumns = AncNbColonne
.RowHeight = AncHauteurBouton
End With
wsDest.Visible = xlSheetVisible
wsDest.Activate
SegmentDeplacer = True
ActiveCell.Select
End If

End If

' Gestion des erreurs:
Gest_Err:
If Err.Number <> 0 Then MsgBox "Erreur: " & Err.Number & " - " & Err.Description, vbCritical
Err.Clear
Application.EnableEvents = AncEnableEvents

End Function

'------------------------------------------------------------------------------------------------------
Function SegmentSupprimer(NomTableau As String, NomColonne As String) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données.
' NomColonne : le nom de la colonne du segment.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si le segment est supprimé.
'------------------------------------------------------------------------------------------------------
If SegmentExiste(NomTableau, NomColonne) = True Then
Sc.Delete
SegmentSupprimer = True
End If

End Function

'------------------------------------------------------------------------------------------------------
Function SegmentEstFiltre(NomTableau As String, NomColonne As String) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données.
' NomColonne : le nom de la colonne du segment.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si le segment est filtré.
'------------------------------------------------------------------------------------------------------

If SegmentExiste(NomTableau, NomColonne) = True Then
SegmentEstFiltre = Not Sc.FilterCleared
End If
End Function

'------------------------------------------------------------------------------------------------------
Function SegmentFiger(NomTableau As String, NomColonne As String, _
Figer As Boolean, Placement As XlPlacement) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données.
' NomColonne : le nom de la colonne du segment.
' Figer : True s'il faut figer la position et la dimension du segment, False s'il faut tout libérer.
' Placement : Propriété du déplacement.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
If SegmentExiste(NomTableau, NomColonne) = True Then
Sc.Slicers(SegmentNuméro).DisableMoveResizeUI = Figer
Sc.Slicers(SegmentNuméro).Shape.Placement = Placement
End If
End Function

'------------------------------------------------------------------------------------------------------
Function SegmentElementExiste(NomTableau As String, NomColonne As String, Item As Variant) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données qui sont filtrées par le segment.
' NomColonne : le nom de la colonne du segment.
' Item : le nom de l'élément.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si l'élément existe dans le segment.
'------------------------------------------------------------------------------------------------------
Dim e As SlicerItem

If SegmentExiste(NomTableau, NomColonne) = True Then
' Boucle sur les éléments du segment:
For Each e In Sc.SlicerItems
' L'élément est celui demandé alors renvoie VRAI:
If e.Name = Item Then SegmentElementExiste = True: Exit For
Next e
End If

End Function

'------------------------------------------------------------------------------------------------------
Function SegmentCompterElements(NomTableau As String, NomColonne As String, QueLesActifs As Boolean) As Integer
'------------------------------------------------------------------------------------------------------
' Renvoie soit le nombre d'éléments qui sont actifs dans un segment, soit le nombre de tous les éléments.
' Les éléments non affichés sont comptabilités aussi.
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données qui sont filtrées par le segment.
' NomColonne : le nom de la colonne du segment.
' QueLesActifs : si VRAI renvoie le nombre d'éléments sélectionnés et avec des données, si FAUX
'                alors renvoie le nombre d'éléments du segment.
'------------------------------------------------------------------------------------------------------
' Exemple d'appel:
' Dim i As Long
' i = SegmentCompterElements("TS_Test", "Colonne A", True)
'------------------------------------------------------------------------------------------------------
Dim e As SlicerItem

If SegmentExiste(NomTableau, NomColonne) = True Then
' Boucle sur les éléments du segment:
For Each e In Sc.SlicerItems
' S'il faut renvoyer que les actifs ou tous:
If QueLesActifs = False Or (e.Selected = True And e.HasData = True) Then
SegmentCompterElements = SegmentCompterElements + 1
End If
Next e
End If

End Function

'------------------------------------------------------------------------------------------------------
Function SegmentListeElements(NomTableau As String, NomColonne As String, QueLesActifs As Boolean) As Variant
'------------------------------------------------------------------------------------------------------
' Renvoie la liste des noms des éléments d'un segment, soit ceux qui sont actifs, soit tous les éléments.
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données qui sont filtrées par le segment.
' NomColonne : le nom de la colonne du segment.
' QueLesActifs : si VRAI ne renvoie que les éléments sélectionnés et avec des données
'                dans une liste en base 1, si FAUX alors renvoie tous les éléments du segment.
'------------------------------------------------------------------------------------------------------
' Exemple d'appel:
' Dim Liste() As Variant, i As Integer
' Liste = SegmentListeElements("TS_Test", "Colonne A", True)
' For i = 1 To UBound(Liste): Debug.Print Liste(i): Next i
'------------------------------------------------------------------------------------------------------
Dim e As SlicerItem, Nb As Integer
Dim Liste() As Variant

If SegmentExiste(NomTableau, NomColonne) = True Then
' Boucle sur les éléments du segment:
For Each e In Sc.SlicerItems
' S'il faut renvoyer que les actifs ou tous:
If QueLesActifs = False Or (e.Selected = True And e.HasData = True) Then
Nb = Nb + 1
ReDim Preserve Liste(1 To Nb)
Liste(Nb) = e.Name
End If
Next e
End If

' Cas ou aucun segment n'est trouvé, initialise la valeur de retour:
If Nb = 0 Then ReDim Liste(0)

' Renvoie la liste (en base 1 si des éléments sont repris):
SegmentListeElements = Liste

End Function

'------------------------------------------------------------------------------------------------------
Function SegmentActiverUnElement(NomTableau As String, NomColonne As String, Item As Variant) As Boolean
'------------------------------------------------------------------------------------------------------
' Active un élément dans un segment, sans désactiver les autres éléments sélectionné.
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données qui sont filtrées par le segment.
' NomColonne : le nom de la colonne du segment.
' Item : l'élément à activer. La casse doit être respectée.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Exemple d'appel:
' Call SegmentActiverUnElement("TS_Test", "Colonne B", "5") => sélectionne l'élément "5".
'------------------------------------------------------------------------------------------------------
Dim e As SlicerItem
Dim AncEnableEvents As Boolean

' Bloque les mises à jours:
Application.Calculation = xlCalculationManual
AncEnableEvents = Application.EnableEvents
Application.EnableEvents = False
Application.ScreenUpdating = False

If SegmentExiste(NomTableau, NomColonne) = True Then
' Sélectionne l'élément demandé (s'il existe):
For Each e In Sc.SlicerItems
If e.Name = Item Then e.Selected = True: SegmentActiverUnElement = True
Next e
End If

' Mise à jour de l'écran:
Application.EnableEvents = AncEnableEvents
Application.Calculation = xlCalculationAutomatic
Application.Calculate
Application.ScreenUpdating = True
End Function

'------------------------------------------------------------------------------------------------------
Function SegmentActiverListeElements(NomTableau As String, NomColonne As String, ListeItems As Variant) As Integer
'------------------------------------------------------------------------------------------------------
' Sélectionne certains éléments dans un segment.
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données qui sont filtrées par le segment.
' NomColonne : le nom de la colonne du segment.
' ListeItems : Liste des éléments à activer. S'il y en a plusieurs alors passer un Array. La casse doit
'              être respectée. Si vide alors active tous les éléments.
'------------------------------------------------------------------------------------------------------
' Renvoie le nombre d'éléments sélectionnés, ou 0 si tout est sélectionné.
'------------------------------------------------------------------------------------------------------
' Exemple d'appel:
' Call SegmentActiverListeElements("TS_Test", "Prénom", Array("Laurent", "Hugo")) => sélectionne ces deux prénoms.
' Call SegmentActiverListeElements("TS_Test", "Prénom", "") => sélectionne tous, ne pas confondre avec "(vide)".
'------------------------------------------------------------------------------------------------------
Dim i As Integer
Dim e As SlicerItem, Liste
Dim TabString() As String, TabReponse As Variant
Dim AncEnableEvents As Boolean

' Bloque les mises à jours:
Application.Calculation = xlCalculationManual
AncEnableEvents = Application.EnableEvents
Application.EnableEvents = False
Application.ScreenUpdating = False

' Force la liste des colonnes au format Array:
If IsArray(ListeItems) = False Then Liste = Array(ListeItems) Else Liste = ListeItems
' Force chr(1) devant et après l'élément car Filter ne traite pas en xlWhole mais en xlPart.
For i = LBound(Liste) To UBound(Liste)
Liste(i) = Chr(1) & Liste(i) & Chr(1)
Next i

If SegmentExiste(NomTableau, NomColonne) = True Then
' Sélectionne tous les éléments (pour en avoir au moins un de sélectionné):
Sc.ClearManualFilter
SegmentActiverListeElements = Sc.SlicerItems.Count
' Désactive les éléments autre que ceux demandés (pour ne garder que ceux demandés):
For Each e In Sc.SlicerItems
TabReponse = Filter(Liste, Chr(1) & e.Name & Chr(1), True)
If UBound(TabReponse) = -1 Then e.Selected = False: SegmentActiverListeElements = SegmentActiverListeElements - 1
Next e
End If

' Mise à jour de l'écran:
Application.EnableEvents = AncEnableEvents
Application.Calculation = xlCalculationAutomatic
Application.Calculate
Application.ScreenUpdating = True
End Function

'------------------------------------------------------------------------------------------------------
Function SegmentElementEstActif(NomTableau As String, NomColonne As String, Item As Variant) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données qui sont filtrées par le segment.
' NomColonne : le nom de la colonne du segment.
' Item : le nom de l'élément.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si l'élément est sélectionné (même s'il n'a pas de données).
'------------------------------------------------------------------------------------------------------
Dim e As SlicerItem

If SegmentExiste(NomTableau, NomColonne) = True Then
' Boucle sur les éléments du segment:
For Each e In Sc.SlicerItems
' L'élément est celui demandé:
If e.Name = Item And e.Selected = True Then SegmentElementEstActif = True: Exit For
Next e
End If

End Function

'------------------------------------------------------------------------------------------------------
Function SegmentEstAvecDonnees(NomTableau As String, NomColonne As String, Item As Variant) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données qui sont filtrées par le segment.
' NomColonne : le nom de la colonne du segment.
' Item : le nom de l'élément.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si l'élément a des données.
'------------------------------------------------------------------------------------------------------
Dim e As SlicerItem

If SegmentExiste(NomTableau, NomColonne) = True Then
' Boucle sur les éléments du segment:
For Each e In Sc.SlicerItems
' L'élément est celui demandé:
If e.Name = Item And e.HasData = True Then SegmentEstAvecDonnees = True: Exit For
Next e
End If

End Function

'------------------------------------------------------------------------------------------------------
Function SegmentDesactiverUnElement(NomTableau As String, NomColonne As String, Item As Variant) As Boolean
'------------------------------------------------------------------------------------------------------
' Désactive un élément dans un segment, sans désactiver les autres éléments sélectionné.
' Si plus aucun élément n'est sélectionné, alors tous sont sélectionnés.
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données qui sont filtrées par le segment.
' NomColonne : le nom de la colonne du segment.
' Item : l'éléments à désactiver. La casse doit être respectée.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim e As SlicerItem
Dim AncEnableEvents As Boolean

' Bloque les mises à jours:
Application.Calculation = xlCalculationManual
AncEnableEvents = Application.EnableEvents
Application.EnableEvents = False
Application.ScreenUpdating = False

If SegmentExiste(NomTableau, NomColonne) = True Then
' Sélectionne l'élément demandé (s'il existe):
For Each e In Sc.SlicerItems
If e.Name = Item Then e.Selected = False: SegmentDesactiverUnElement = True
Next e
End If

' Mise à jour de l'écran:
Application.EnableEvents = AncEnableEvents
Application.Calculation = xlCalculationAutomatic
Application.Calculate
Application.ScreenUpdating = True
End Function

'------------------------------------------------------------------------------------------------------
Function SegmentEffacerTousLesFiltres(Optional NomTableau As String = "") As Boolean
'------------------------------------------------------------------------------------------------------
' Efface les filtress des segments liés aux TS ou aux TCD du classeur actif.
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données des segments.
'              Si vide alors traite tous les tableaux du classeur.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim AncEnableEvents As Boolean

' Bloque les mises à jours:
Application.Calculation = xlCalculationManual
AncEnableEvents = Application.EnableEvents
Application.EnableEvents = False
Application.ScreenUpdating = False

' Boucle sur les segments du classeur:
For Each Sc In ActiveWorkbook.SlicerCaches
If Sc.SlicerCacheType = 0 Or Sc.SlicerCacheType = 1 Then ' TS ou TCD
If Sc.ListObject.Name = NomTableau Or NomTableau = "" Then
Sc.ClearManualFilter
SegmentEffacerTousLesFiltres = True
End If
End If
Next Sc

' Mise à jour de l'écran:
Application.EnableEvents = AncEnableEvents
Application.Calculation = xlCalculationAutomatic
Application.Calculate
Application.ScreenUpdating = True

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

'------------------------------------------------------------------------------------------------------
Function SegmentSaisirSelection(NomTableau As String, NomColonne As String) As Boolean
'------------------------------------------------------------------------------------------------------
' Ouvre une boîte de saisie pour permettre à l'utilisateur de saisir un mot clé afin
' d'activer un ou plusieurs éléments dans un segment.
'------------------------------------------------------------------------------------------------------
' NomTableau : le nom du Tableau Structuré ou du TCD qui contient les données.
' NomColonne : le nom de la colonne du segment.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim Liste As Variant, i As Integer, ik As Integer
Dim Choix As String

If SegmentExiste(NomTableau, NomColonne) = True Then
' Saisie du filtre:
Choix = InputBox("Le mot clé doit respectez la casse." & vbCrLf _
& "Vous pouvez utiliser les jokers :" & vbCrLf _
& "* (étoile) pour remplacer plusieurs caractères." & vbCrLf _
& "? (point d'interrogation) pour remplacer un caractère." & vbCrLf _
& "Si aucun élément n'est trouvé, la rechercher sera relancée sans " _
& "respecter la casse et avec le joker étoile en début et fin de mot clé.", "Sélection dans le segment " & NomColonne)
' Si une saisie est faite:
If Choix <> "" Then
' Récupère la liste des éléments du segment:
Liste = SegmentListeElements(NomTableau, NomColonne, False)
ReDim Filtre(1 To 1): ik = 1
' Cherche les éléments correspondants suivant la saisie:
For i = 1 To UBound(Liste)
If Liste(i) Like Choix Then
ReDim Preserve Filtre(1 To ik)
Filtre(ik) = Liste(i)
ik = ik + 1
End If
Next i
' Si aucun élément trouvé alors nouvelle recherche sans la casse et avec les jokers:
If ik = 1 Then
Choix = "*" & UCase(Choix) & "*"
For i = 1 To UBound(Liste)
If UCase(Liste(i)) Like Choix Then
ReDim Preserve Filtre(1 To ik)
Filtre(ik) = Liste(i)
ik = ik + 1
End If
Next i
End If
' Si au moins un élément de trouvé alors lance la sélection:
If ik > 1 Then
Call SegmentActiverListeElements(NomTableau, NomColonne, Filtre)
SegmentSaisirSelection = True
End If
End If
End If

End Function

'------------------------------------------------------------------------------------------------------
Sub SegmentActifSaisir()
'------------------------------------------------------------------------------------------------------
' Ouvre une boîte de saisie pour permettre à l'utilisateur de saisir un mot clé afin de
' d'activer un ou plusieurs éléments dans le segment qu'il a sélectionné.
' Macro à lancer via un évènement "Application.OnKey".
'------------------------------------------------------------------------------------------------------
Dim UserSelection As Variant
Dim Tableau As String

' Gestion des erreurs:
On Error GoTo Gest_Err

'Récupérer la sélection à l'écran
Set UserSelection = ActiveWindow.Selection

'Déterminer si la sélection est un segment
If SegmentExiste("", UserSelection.Name) = True Then _
Call SegmentSaisirSelection(Sc.ListObject.Name, UserSelection.Name)

' Désactive le segment:
ActiveCell.Select

' Gestion des erreurs:
Gest_Err:
Err.Clear

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

'------------------------------------------------------------------------------------------------------
Function ChronologieExiste(NomTCD As String) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTCD : le nom du Tableau Croisé Dynamique qui contient les données.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si la chronologie existe et renseigne Sc.
'------------------------------------------------------------------------------------------------------
For Each Sc In ActiveWorkbook.SlicerCaches
If Sc.SlicerCacheType = xlTimeline Then
If Sc.PivotTables.Item(1).Name = NomTCD Then
ChronologieExiste = True
Exit For
End If
End If
Next Sc

End Function

'------------------------------------------------------------------------------------------------------
Function ChronologieStyle(NomTCD As String, NouveauStyle As SlicerCachesStyle) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTCD : le nom du Tableau Croisé Dynamique qui contient les données.
' NouveauStyle : l'une des 12 valeurs de l'énumération "SlicerCachesStyle"
'------------------------------------------------------------------------------------------------------
' Renvoie : True si le style a été appliqué.
'------------------------------------------------------------------------------------------------------
Dim CachesStyle
CachesStyle = Array("SlicerStyleLight1", "SlicerStyleLight2", "SlicerStyleLight3" _
, "SlicerStyleLight4", "SlicerStyleLight5", "SlicerStyleLight6" _
, "SlicerStyleDark1", "SlicerStyleDark2", "SlicerStyleDark3" _
, "SlicerStyleDark4", "SlicerStyleDark5", "SlicerStyleDark6")

If ChronologieExiste(NomTCD) = True Then
Sc.Slicers(SegmentNuméro).Style = "Time" & CachesStyle(NouveauStyle)
ChronologieStyle = True
End If

End Function

'------------------------------------------------------------------------------------------------------
Function ChronologieTaille(NomTCD As String, _
Optional Hauteur As Double = 0, _
Optional Largeur As Double = 0) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTCD : le nom du Tableau Croisé Dynamique qui contient les données.
' Hauteur : si différent de zéro, la hauteur (en point) de la chronologie.
' Largeur : si différent de zéro, la largeur (en points) de la chronologie.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
If ChronologieExiste(NomTCD) = True Then

If Hauteur > 0 Then Sc.Slicers(SegmentNuméro).Height = Hauteur
If Largeur > 0 Then Sc.Slicers(SegmentNuméro).Width = Largeur

ActiveCell.Select
ChronologieTaille = True

End If

End Function

'------------------------------------------------------------------------------------------------------
Function ChronologieInfos(NomTCD As String, _
Optional Début As Variant, _
Optional FiltreMini As Variant, _
Optional FiltreMaxi As Variant, _
Optional Fin As Variant) As Boolean
'------------------------------------------------------------------------------------------------------
' NomTCD : le nom du Tableau Croisé Dynamique qui contient les données.
' Début = date de début de la chronologie
' FiltreMini = date de début du filtre
' FiltreMaxi = date de fin du filtre
' Fin = date de fin du chronologie
'------------------------------------------------------------------------------------------------------
' Remarques:
' Les données sont en lecture seule.
' Si pas de filtre alors une erreur 1004 est levée et l'on recherche le mini et maxi du TCD.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si la chronologie est filtrée, False si elle ne l'est pas.
'------------------------------------------------------------------------------------------------------
If ChronologieExiste(NomTCD) = True Then
On Error Resume Next
Err.Clear
Début = Sc.TimelineState.StartDate
FiltreMini = Sc.TimelineState.FilterValue1
FiltreMaxi = Sc.TimelineState.FilterValue2
Fin = Sc.TimelineState.EndDate
' S'il y a un filtre alors renvoie True:
If Err.Number = 0 Then
ChronologieInfos = True
Else
' Si pas de filtre alors retrouve le mini et maxi du TCD:
Dim i As Long, MaDate As Variant
With Sc.PivotTables.Item(1)
For i = 1 To .DataBodyRange.Count
MaDate = .DataBodyRange(i, 1)
If IsDate(MaDate) = True Then
If Début = "" Then Début = MaDate
If MaDate < Début Then Début = MaDate
If MaDate > Fin Then Fin = MaDate
End If
Next i
FiltreMini = Début
FiltreMaxi = Fin
End With
End If
On Error GoTo 0
Err.Clear
End If

End Function

'------------------------------------------------------------------------------------------------------
Function ChronologieFiltrer(NomTCD As String, FiltreMini As Date, FiltreMaxi As Date) As Boolean
'------------------------------------------------------------------------------------------------------
' Pose les filtres d'une chronologie.
'------------------------------------------------------------------------------------------------------
' NomTCD : le nom du Tableau Croisé Dynamique qui contient les données.
' FiltreMini = date de début du filtre
' FiltreMaxi = date de fin du filtre
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err

' Modifie les filtres du TCD:
If ChronologieExiste(NomTCD) = True Then
With Sc.PivotTables.Item(1).PivotFields.Item(1)
.ClearAllFilters
.PivotFilters.Add2 Type:=xlDateBetween, WholeDayFilter:=True, _
Value1:=Format(FiltreMini, "dd/mm/yyyy"), Value2:=Format(FiltreMaxi, "dd/mm/yyyy")
End With
ChronologieFiltrer = True
End If

Gest_Err:
Err.Clear
End Function

'------------------------------------------------------------------------------------------------------
Function ChronologieEffacer(Optional NomTCD As String = "") As Boolean
'------------------------------------------------------------------------------------------------------
' Efface les filtres de toutes les chronologies (si NomTCD est vide) ou seulement dz la chronologie
' indiquée dans NomTCD
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Boucle sur les chronologies du classeur:
For Each Sc In ActiveWorkbook.SlicerCaches
If Sc.SlicerCacheType = xlTimeline Then
If Sc.PivotTables.Item(1).Name = NomTCD Or NomTCD = "" Then
Sc.ClearDateFilter
ChronologieEffacer = True
End If
End If
Next Sc

End Function

'------------------------------------------------------------------------------------------------------
Function ChronologieActualiser(Optional NomTCD As String = "") As Boolean
'------------------------------------------------------------------------------------------------------
' Actualiser toutes les chronologies (si NomTCD est vide) ou seulement la chronologie indiquée
' dans NomTCD. La mise à jour de la chronologie déclenche la mise à jour du TCD source.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
' Boucle sur les chronologies du classeur:
For Each Sc In ActiveWorkbook.SlicerCaches
If Sc.SlicerCacheType = xlTimeline Then
If Sc.PivotTables.Item(1).Name = NomTCD Or NomTCD = "" Then
Sc.PivotTables.Item(1).PivotCache.Refresh
ChronologieActualiser = True
End If
End If
Next Sc

End Function

'------------------------------------------------------------------------------------------------------
Function ChronologieLiaisonsTCD(NomTCD As String) As Boolean
'------------------------------------------------------------------------------------------------------
' Mise à jour du Tableau Structuré lié au TCD actualisé lors de la modification de la chronologie.
' Cette fonction doit être lancée par un événement "Worksheet_PivotTableUpdate" sur la feuille
' qui contient le TCD.
' Exemple d'utilisation:
' Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
' Call ChronologieLiaisonsTCD(Target.Name)
' End Sub
'------------------------------------------------------------------------------------------------------
' NomTCD : le nom du Tableau Croisé Dynamique qui contient les données.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim Pt As PivotTable, Sh As Worksheet, i As Integer, ik As Integer
Dim Source As String, NomTS As String, ColonneTS As Variant
Dim TS As Range
Dim D1 As String, D2 As String

' Gestion des erreurs:
On Error GoTo Gest_Err

' Boucle sur les feuilles du classeur actif:
For Each Sh In ActiveWorkbook.Sheets
' Boucle sur les TCD:
For Each Pt In Sh.PivotTables
For i = 1 To Sh.PivotTables.Count
' Si c'est le TCD concerné:
If Sh.PivotTables(i).Name = NomTCD Then
' Récupère la source des données du TCD (le TS et sa colonne):
Source = Sh.PivotTables(Sh.PivotTables(i).Name).SourceData
ik = InStr(1, Source, "[")
NomTS = Left(Source, ik - 1)
ColonneTS = Mid(Source, ik + 1, Len(Source) - ik - 1)
' Initialise le TS source:
Set TS = Range(NomTS)
' Récupère le numéro de la colonne du TS:
ColonneTS = TS.ListObject.ListColumns(ColonneTS).Index
' Si une chronologie active est liée au TCD:
If ChronologieInfos(NomTCD, , D1, D2) = True Then
' Transforme les dates du filtre au format anglosaxon et en chaîne:
D1 = Year(D1) & "/" & Month(D1) & "/" & Day(D1)
D2 = Year(D2) & "/" & Month(D2) & "/" & Day(D2)
' Filtre la colonne dans le TS:
TS.ListObject.Range.AutoFilter Field:=ColonneTS, Criteria1:=">=" & D1, Operator:=xlAnd, Criteria2:="<=" & D2
Else
' Sinon, efface le filtre sur la colonne du TS:
TS.ListObject.Range.AutoFilter Field:=ColonneTS
End If
ChronologieLiaisonsTCD = True
Exit Function
End If
Next i
Next Pt
Next Sh

' Gestion des erreurs:
Gest_Err:
Err.Clear
End Function

'------------------------------------------------------------------------------------------------------
Function ChronologieLiaisonsTS(NomTS As String) As Boolean
'------------------------------------------------------------------------------------------------------
' Mise à jour du TCD lié au TS. Cette fonction doit être lancée par un événement "Worksheet_Change" sur
' la feuille qui contient le TS.
' Exemple d'utilisation:
' Private Sub Worksheet_Change(ByVal Target As Range)
' Call ChronologieLiaisonsTS("TS_Eleves")
' End Sub
'------------------------------------------------------------------------------------------------------
' NomTS : le nom du Tableau Structuré qui contient les données.
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim Pt As PivotTable, Sh As Worksheet, i As Integer, ik As Integer
Dim Source As String

' Gestion des erreurs:
On Error GoTo Gest_Err

' Si la modification ou l'ajout est fait dans le TS demandé:
If ActiveSheet.ListObjects(NomTS).Active = True Then
' Boucle sur les feuilles du classeur actif:
For Each Sh In ActiveWorkbook.Sheets
' Boucle sur les TCD:
For Each Pt In Sh.PivotTables
For i = 1 To Sh.PivotTables.Count
' Récupère le nom du TS qui est la source du TCD:
Source = Sh.PivotTables(i).SourceData
ik = InStr(1, Source, "[")
' Si c'est le TS concerné alors rafraichit le TCD:
If Left(Source, ik - 1) = NomTS Then
Application.EnableEvents = False
Sh.PivotTables(i).PivotCache.Refresh
Application.EnableEvents = True
ChronologieLiaisonsTS = True
'Exit Function
End If
Next i
Next Pt
Next Sh
End If

Gest_Err:
Err.Clear
End Function

'------------------------------------------------------------------------------------------------------
Sub ChronologieAnnulerSélection()
'------------------------------------------------------------------------------------------------------
End Sub
'------------------------------------------------------------------------------------------------------
'------------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------------
Function SegmentMasquerAfficherColonneTS(TSSegment As String, NomTableau As String) As Boolean
'------------------------------------------------------------------------------------------------------
' Affiche ou masque des colonnes dans un TS suivant la sélection des éléments d'un segment.
'------------------------------------------------------------------------------------------------------
' TSSegment : le nom du Tableau Structuré qui contient les données du segment.
' NomTableau : le nom du Tableau Structuré dont il faut masquer ou afficher les colonnes.
'------------------------------------------------------------------------------------------------------
' Exemple sur la feuille qui contient le tableau "TS_Afficher" source des segments avec la liste
' des colonnes concernées du tableau "TS_Eleves":
' Private Sub Worksheet_Calculate()
' Call SegmentMasquerAfficherColonneTS("TS_Afficher", "TS_Eleves")
' End Sub
'------------------------------------------------------------------------------------------------------
' Renvoie : True si tout s'est bien passé.
'------------------------------------------------------------------------------------------------------
Dim i As Integer, ik As Integer, Colonne As Integer, Liste() As Variant
Dim TS As Range

' Gestion des erreurs:
On Error Resume Next

' Pour éviter les boucles sans fin il faut désactiver la gestion des évènements:
Application.EnableEvents = False

' Définition du Tableau Structuré à mettre à jour:
Set TS = Range(NomTableau)

' Charge la liste des segments:
Liste = SegmentListeElements(TSSegment, "", False)

' Si le segment est filtré:
If SegmentEstFiltre(TSSegment, "") = True Then
' Boucle sur les éléments:
For i = 1 To UBound(Liste)
' Récupère le numéro de colonne du champs dans la tableau structuré:
Colonne = 0
Colonne = TS.ListObject.ListColumns(Liste(i)).Index
' Si l'élément n'est pas un nom de colonne du tableau structuré (comme "Aucune Colonne"):
If Colonne = 0 Then
' Si l'élément est actif alors il faut afficher aucune colonne:
If SegmentElementEstActif(TSSegment, "", Liste(i)) = True Then
' Désactive tous les autres éléments:
For ik = 1 To UBound(Liste)
If ik <> i Then Call SegmentDesactiverUnElement(TSSegment, "", Liste(ik))
Next ik
End If
End If
Next i
End If

' Boucle sur les éléments:
For i = 1 To UBound(Liste)
' Récupère le numéro de colonne du champs dans la tableau structuré:
Colonne = 0
Colonne = TS.ListObject.ListColumns(Liste(i)).Index
' Si l'élément a une colonne dans le tableau:
If Colonne > 0 Then ' Si l'élément est actif alors on affiche la colonne, sinon on la masque:
If SegmentElementEstActif(TSSegment, "", Liste(i)) = True Then
Sheets(TS.Parent.Name).Columns(Colonne + TS.Column - 1).EntireColumn.Hidden = False
Else
Sheets(TS.Parent.Name).Columns(Colonne + TS.Column - 1).EntireColumn.Hidden = True
End If
SegmentMasquerAfficherColonneTS = True
' Si l'élément n'a pas de colonne dans le tableau:
Else ' Si tout est sélectionné alors ne pas le sélectionner :
If SegmentEstFiltre(TSSegment, "") = False Then Call SegmentDesactiverUnElement(TSSegment, "", Liste(i))
End If
Next i

' Gestion des erreurs:
Gest_Err:
Err.Clear

' Active la gestion des évènements:
Application.EnableEvents = True

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