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

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

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

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

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

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

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

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

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

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

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

' Autres traitements:

' ...

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_ConvertirPlageEnTS(TD As Range, _
                                      Optional ByRef Nom As String = "", _
                                      Optional ByRef Style As String = "*", _
                                      Optional AvecEntete As XlYesNoGuess = xlYes) As Range
'------------------------------------------------------------------------------------------------
' Transforme une plage classique en un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TD : La plage concernée (ou la cellule haut gauche) du tableau de données.
' Nom : Le nom à donner au tableau ou vide pour prendre le nom attribué par EXCEL.
' Style : Le style ou * pour le style par défaut ou vide pour aucun style.
' AvecEntete : Indique si la première ligne contient des en-têtes :
'              xlYes : la plage contient des en-têtes;
'              xlNo : la plage ne contient pas d'en-tête et Excel les rajoute;
'              xlGuess : Excel détecte automatiquement si la plage contient ou non des en-têtes.
'------------------------------------------------------------------------------------------------
' Renvoie : La plage Range qui représente la plage du Tableau Structuré créé.
'------------------------------------------------------------------------------------------------
' Exemple :
' Dim TS As Range
' Set TS = ConvertirPlageEnTS(Range("K3"))
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear
 
' Si le TD n'existe pas déjà alors le créer:
If TD.ListObject Is Nothing Then
    
    ' Si TD ne représente qu'une seule cellule alors étend la plage:
    If TD.Count = 1 Then Set TD = TD.CurrentRegion
     
    ' Création du Tableau Structuré en attribuant le nom passé ou en prenant celui attribué par EXCEL:
    If Nom > "" Then
        TD.Parent.ListObjects.Add(xlSrcRange, TD, , AvecEntete).Name = Nom
    Else
        TD.Parent.ListObjects.Add xlSrcRange, TD, , AvecEntete
    End If
     
    ' Modifie le style s'il ne faut pas prendre celui par défaut, ou pas de style si vide:
    If Style <> "*" Then TD.Parent.ListObjects(TD.ListObject.Name).TableStyle = Style

End If

' Renseigne le nom du Tableau Structuré et son style:
Nom = TD.ListObject.DisplayName
Style = TD.Parent.ListObjects(TD.ListObject.Name).TableStyle
 
' Renvoie la plage du Tableau Structuré:
Set TS_ConvertirPlageEnTS = TD
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ConvertirPlageEnTS", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ConvertirPlageEnTS"
End If
Err.Clear

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

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

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

' Si le tableau existe déjà alors le renvoyer:
If Not Plage.ListObject Is Nothing Then
    Nom = Plage.ListObject.DisplayName
    Style = Plage.ListObject.TableStyle
    Set TS_CréerUnTableau = Range(Plage.ListObject)
Else
    ' Affiche les titres:
    If IsArray(Titres) = True Then
        Plage.Resize(1, UBound(Titres) + 1).Value = Titres
    Else
        Plage.Value = Titres
    End If
    ' Conversion de la plage en un Tableau Structuré:
    Set TS_CréerUnTableau = TS_ConvertirPlageEnTS(Plage, Nom, Style)
 End If
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_CréerUnTableau", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_CréerUnTableau"
End If
Err.Clear

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_SupprimerLeTableau(TS As Range) As Boolean
'------------------------------------------------------------------------------------------------
' Suppression d'un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear
 
' Supprime le tableau:
TS.ListObject.Delete
TS_SupprimerLeTableau = True
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_SupprimerLeTableau", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_SupprimerLeTableau"
End If

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

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

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

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

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

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

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

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

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

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

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

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_ChangerLibellé(TS As Range, _
                                  ByVal Colonne As Variant, _
                                  Libellé As String) As Boolean
'------------------------------------------------------------------------------------------------
' Change l'affichage de l'en-tête dans un Tableau Structuré, mais pas son nom.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Libellé : le libellé à afficher à la place du nom du champ, ou vide pour le nom d'origine.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
 
' Affiche l'en-tête et change le libellé:
TS.ListObject.ShowHeaders = True
If Libellé <> "" Then
    TS.ListObject.HeaderRowRange(Colonne).NumberFormat = "0;"""";"""";""" & Libellé & """"
Else
    TS.ListObject.HeaderRowRange(Colonne).NumberFormat = "@"
End If
TS_ChangerLibellé = True
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_ChangerLibellé", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_ChangerLibellé"
End If

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

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_EffacerUneLigne(TS As Range, ByVal Ligne As Long) As Boolean
'------------------------------------------------------------------------------------------------
' Efface le contenu d'une ligne dans un Tableau Structuré, mais ne la supprime pas, même si elle est masquée.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Ligne : la position de la ligne à effacer dans le tableau.
'         Si 0 alors efface la dernière ligne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si l'effacement a été réalisé. 
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Contrôle la cohérence de la ligne passée en argument:
Ligne = TS_IndexLigne(TS, Ligne)
If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
 
' Efface la ligne:
Select Case TS.ListObject.ListRows.Count
Case Is > 1
    TS.ListObject.DataBodyRange.Rows(Ligne).Clear
Case 1
    Dim i As Long
    For i = 1 To TS.ListObject.ListColumns.Count
        TS.ListObject.DataBodyRange(1, i).Clear
    Next i
End Select
TS_EffacerUneLigne = True
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_EffacerUneLigne", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_EffacerUneLigne"
End If

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_EffacerToutesLignes(TS As Range) As Boolean
'------------------------------------------------------------------------------------------------
' Efface le contenu de toutes les lignes dans un Tableau Structuré, mais ne les supprime pas, 
' même si elles sont masquées.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Efface toutes les lignes du tableau:
Select Case TS.ListObject.ListRows.Count
Case Is > 1
    TS.ListObject.DataBodyRange.Clear
Case 1
    Dim i As Long
    For i = 1 To TS.ListObject.ListColumns.Count
        TS.ListObject.DataBodyRange(1, i).Clear
    Next i
End Select
TS_EffacerToutesLignes = True
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_EffacerToutesLignes", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_EffacerToutesLignes"
End If
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------

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

'------------------------------------------------------------------------------------------------
Public Function TS_AjouterUneLigne(TS As Range, Optional ByVal Ligne As Long = 0) As Boolean
'------------------------------------------------------------------------------------------------
' Ajoute une ligne dans un Tableau Structuré (même si elle est masquée).
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Ligne : la position où ajouter la ligne dans le tableau.
'         Si 0 alors ajoute la ligne à la suite du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une ligne a été ajoutée.
'------------------------------------------------------------------------------------------------
Dim MesFiltres As Variant
Dim Anc_ScreenUpdating As Boolean
 
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Contrôle la cohérence de la ligne passée en argument:
If Ligne <> 0 Then
    Ligne = TS_IndexLigne(TS, Ligne)
    If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
End If
 
' Bloque la mise à jour de l'écran:
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
 
' Mémorise les éventuels filtres et les retire:
Call TS_Filtres_Mémoriser(TS, MesFiltres)
Call TS_Filtres_Effacer(TS)
 
Select Case Ligne
 
    Case 0 ' Si le tableau est vierge alors il faut l'initialiser:
        If TS.ListObject.ListRows.Count = 0 Then
            Set TS = TS.ListObject.ListRows.Add.Range
        Else
            ' Ajoute une ligne en bas du tableau:
            TS.ListObject.ListRows.Add
        End If
        TS_AjouterUneLigne = True
        
    Case 1 To TS.ListObject.ListRows.Count ' Ajoute dans le tableau
        TS.ListObject.ListRows.Add Ligne
        TS_AjouterUneLigne = True
    
End Select
 
' Restaure les filtres et l'affichage:
Call TS_Filtres_Restaurer(TS, MesFiltres)
Application.ScreenUpdating = Anc_ScreenUpdating
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_AjouterUneLigne", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_AjouterUneLigne"
End If
Err.Clear
 
End Function
‘------------------------------------------------------------------------------------------------

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

'------------------------------------------------------------------------------------------------
Public Function TS_SupprimerUneLigne(TS As Range, ByVal Ligne As Long) As Boolean
'------------------------------------------------------------------------------------------------
' Supprime une ligne dans un Tableau Structuré, même si elle est masquée.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Ligne : la position de la ligne à supprimer dans le tableau.
'         Si 0 alors supprime la dernière ligne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une ligne a été supprimée.
'------------------------------------------------------------------------------------------------
Dim MesFiltres As Variant
Dim Anc_ScreenUpdating As Boolean
 
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Contrôle la cohérence de la ligne passée en argument:
Ligne = TS_IndexLigne(TS, Ligne)
If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
   
' Bloque la mise à jour de l'écran:
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
 
' Mémorise les éventuels filtres et les retire:
Call TS_Filtres_Mémoriser(TS, MesFiltres)
Call TS_Filtres_Effacer(TS)
 
' Supprime la ligne:
TS.ListObject.ListRows(Ligne).Delete
TS_SupprimerUneLigne = True
 
' Restaure les filtres et l'affichage:
Call TS_Filtres_Restaurer(TS, MesFiltres)
Application.ScreenUpdating = Anc_ScreenUpdating
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_SupprimerUneLigne", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_SupprimerUneLigne"
End If
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------

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

'------------------------------------------------------------------------------------------------
Public Function TS_SupprimerPlusieursLignes(TS As Range, ByVal LigneDébut As Long, ByVal LigneFin As Long) As Boolean
'------------------------------------------------------------------------------------------------
' Supprime plusieurs lignes dans un Tableau Structuré, même si elles sont masquées.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' LigneDébut : La position de la première ligne à supprimer dans le tableau.
' LigneFin   : La position de la dernière ligne à supprimer dans le tableau
'              Si 0 alors supprime la dernière ligne du tableau.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si une ligne a été supprimée.
'------------------------------------------------------------------------------------------------
' Remarque : Une fois toutes les lignes supprimées, il ne reste qu'une ligne vide sous l'en-tête.
'------------------------------------------------------------------------------------------------
Dim MesFiltres As Variant
Dim Anc_ScreenUpdating As Boolean
Dim Ligne As Long
 
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Si la ligne de début est hors du tableau alors ne rien faire:
If LigneDébut > TS.ListObject.ListRows.Count Then
    TS_SupprimerPlusieursLignes = True
    GoTo Gest_Err
End If
 
' Contrôle la cohérence des lignes passées en argument:
LigneDébut = TS_IndexLigne(TS, LigneDébut)
If LigneDébut = -1 Then Err.Raise vbObjectError, , TS_Err_Description
LigneFin = TS_IndexLigne(TS, LigneFin)
If LigneFin = -1 Then Err.Raise vbObjectError, , TS_Err_Description
   
' S'il faut inverser le début et la fin:
If LigneFin < LigneDébut Then
    Ligne = LigneDébut
    LigneDébut = LigneFin
    LigneFin = Ligne
End If

' Bloque la mise à jour de l'écran:
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
 
' Mémorise les éventuels filtres et les retire:
Call TS_Filtres_Mémoriser(TS, MesFiltres)
Call TS_Filtres_Effacer(TS)
 
' Supprime les lignes:
TS.ListObject.DataBodyRange.Rows(LigneDébut & ":" & LigneFin).Delete
TS_SupprimerPlusieursLignes = True
 
' Restaure les filtres et l'affichage:
Call TS_Filtres_Restaurer(TS, MesFiltres)
Application.ScreenUpdating = Anc_ScreenUpdating
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_SupprimerPlusieursLignes", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_SupprimerPlusieursLignes"
End If
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------

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

'------------------------------------------------------------------------------------------------
Public Function TS_SupprimerToutesLignes(TS As Range) As Boolean
'------------------------------------------------------------------------------------------------
' Supprime toutes les lignes d'un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Efface les éventuels filtres:
Call TS_Filtres_Effacer(TS)
 
' Supprime toutes les lignes:
If Not TS.ListObject.DataBodyRange Is Nothing Then TS.ListObject.DataBodyRange.Delete
TS_SupprimerToutesLignes = True
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_SupprimerToutesLignes", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_SupprimerToutesLignes"
End If
Err.Clear

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

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

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

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

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

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

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

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

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

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

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

' Bloque la mise à jour de l'écran:
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
 
' Mémorise les éventuels filtres et les retire:
Call TS_Filtres_Mémoriser(TS, MesFiltres)
Call TS_Filtres_Effacer(TS)
 
' Supprime les lignes qui étaient masquées:
For y = TS_Nombre_Lignes(TS) To 1 Step -1
    If Lignes(y) = 0 Then TS.ListObject.ListRows(y).Delete
Next y

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Select Case Colonne
 
    Case 0 ' Ajoute une colonne à la suite du tableau:
        TS.ListObject.ListColumns.Add.Name = Nom
        Nom = TS.ListObject.ListColumns(TS.ListObject.ListColumns.Count).Name
        TS.ListObject.HeaderRowRange(TS.ListObject.ListColumns.Count).NumberFormat = "@"
        TS_AjouterUneColonne = True
        
    Case Else ' Ajoute une colonne dans le tableau:
        TS.ListObject.ListColumns.Add(Colonne).Name = Nom
        Nom = TS.ListObject.ListColumns(Colonne).Name
        TS.ListObject.HeaderRowRange(Colonne).NumberFormat = "@"
        TS_AjouterUneColonne = True
        
End Select
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_AjouterUneColonne", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_AjouterUneColonne"
End If
Err.Clear

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_SupprimerUneColonne(TS As Range, ByVal Colonne As Variant) As Boolean
'------------------------------------------------------------------------------------------------
' Supprime une colonne dans un tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne à supprimer.
'           Si vide ou 0 alors supprime la dernière colonne du Tableau Structuré.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une colonne a été supprimée.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description

 
' Supprime une colonne dans le tableau:
TS.ListObject.ListColumns(Colonne).Delete
TS_SupprimerUneColonne = True
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise Err.Number, "TS_SupprimerUneColonne", Err.Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox Err.Number & " : " & Err.Description, vbInformation, "TS_SupprimerUneColonne"
End If
Err.Clear

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

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

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

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

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

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

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

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

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

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

' S'il faut déplacer la colonne:
If Colonne_Source <> Colonne_Dest Then
    
    ' Mémorise les éventuels filtres et les retire:
    Call TS_Filtres_Mémoriser(TS, MesFiltres)
    Call TS_Filtres_Effacer(TS)
    
    ' Mémorise le nom de la colonne source:
    Nom = TS.ListObject.ListColumns(Colonne_Source).Name
    ' Mémorise toutes les formules:
    Copie = TS.ListObject.DataBodyRange.Formula
    ' Corrige le numéro de la colonne destination si ajout:
    If Colonne_Source < Colonne_Dest Then Colonne_Dest = Colonne_Dest + 1
    ' Ajoute une colonne et mémorise le nom attribué par Excel:
    TS.ListObject.ListColumns.Add Position:=Colonne_Dest
    NomCréé = TS.ListObject.ListColumns(Colonne_Dest).Name
    ' Retrouve la position de la colonne source:
    Colonne_Source = TS.ListObject.ListColumns(Nom).Index
    ' Copie la source dans la destination puis supprime la source:
    TS.ListObject.ListColumns(Colonne_Source).DataBodyRange.Cut TS.ListObject.ListColumns(Colonne_Dest).DataBodyRange
    TS.ListObject.ListColumns(Colonne_Source).Delete
    ' Retrouve la position de la colonne destination pour lui affecté le nom d'origine:
    Colonne_Dest = TS.ListObject.ListColumns(NomCréé).Index
    TS.ListObject.ListColumns(Colonne_Dest).Name = Nom
    ' Ainsi que ses formules:
    TS.ListObject.ListColumns(Colonne_Dest).DataBodyRange.Formula = Copie
    
    ' Restaure les filtres et l'affichage:
    Call TS_Filtres_Restaurer(TS, MesFiltres)
    
    ' Restaure les titres:
    For i = 1 To TS.ListObject.ListColumns.Count
        id = TS.ListObject.ListColumns(Titre(i, 1)).Index
        TS.ListObject.ListColumns(id).Range.ColumnWidth = Titre(i, 2)
        TS.ListObject.HeaderRowRange(id).NumberFormat = Titre(i, 3)
        ' Restaure les formules:
        For y = 1 To TS.ListObject.ListRows.Count
            TS.ListObject.Range(y + 1, id) = Copie(y, i)
        Next y
    Next i

End If

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    ' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
    Colonne = TS_IndexColonne(TS, Colonne)
    If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
    
    ' Mémorise l'état visibile ou non de la colonne puis la masque:
    AncVisible = Sheets(TS.Parent.Name).Columns(Colonne + TS.Column - 1).EntireColumn.Hidden
    Sheets(TS.Parent.Name).Columns(Colonne + TS.Column - 1).EntireColumn.Hidden = True
    
    ' Efface une colonne dans le tableau:
    TS.ListObject.ListColumns(Colonne).DataBodyRange.Clear
    
    ' Puis restaure l'ancien état visible ou non de la colonne:
    Sheets(TS.Parent.Name).Columns(Colonne + TS.Column - 1).EntireColumn.Hidden = AncVisible

End If

' Renvoie Vrai:
TS_EffacerUneColonne = True

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

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

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

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

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

If StyleTableau <> "/" Then
    Sheets(TS.Parent.Name).ListObjects(TS.ListObject.DisplayName).TableStyle = StyleTableau
End If
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number = 0 Then TS_OptionsStyle = True
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_OptionsStyle", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_OptionsStyle"
End If
Err.Clear

Exit Function

Poser_Filtre:
TS.ListObject.Range.AutoFilter
Resume Next

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_DéfinirTotaux(TS As Range, _
                                 ByVal Colonne As Variant, _
                                 TypeCalcul As XlTotalsCalculation) As Boolean
'------------------------------------------------------------------------------------------------
' Définit le type de calcul pour la ligne des totaux d'une colonne.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' TypeCalcul : Type de calcul à appliquer suivant l'énumération.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
 
' Affiche les totaux et pose le calcul:
TS.ListObject.ShowTotals = True
TS.ListObject.ListColumns(Colonne).TotalsCalculation = TypeCalcul
TS_DéfinirTotaux = True
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_DéfinirTotaux", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_DéfinirTotaux"
End If
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------

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

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

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

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

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

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

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

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

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

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

End If

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

    ' Les données:
    If (Aligner And TS_Aligner_Données) > 0 Then _
        TS.ListObject.ListColumns(Colonne).DataBodyRange.VerticalAlignment = AlignementVertical
    
    ' L'en-tête:
    If (Aligner And TS_Aligner_Entete) Then _
        TS.ListObject.ShowHeaders = True: TS.ListObject.HeaderRowRange(Colonne).VerticalAlignment = AlignementVertical
        
    ' Le total:
    If (Aligner And TS_Aligner_Total) > 0 Then _
        TS.ListObject.ShowTotals = True: TS.ListObject.ListColumns(Colonne).Total.VerticalAlignment = AlignementVertical

End If

' Renvoie VRAI:
TS_Aligner = True

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

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

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

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

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

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

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

' S'il faut effacer tous les anciens tris ou juste
' le tri sur la colonne concerné pour pouvoir en mettre un nouveau:
If EffacerAncienTri = True Then
    Call TS_EffacerTri(TS, "")
Else
    Call TS_EffacerTri(TS, Colonne)
End If
  
' Pose le tri sur la colonne:
TS.ListObject.Sort.SortFields.Add Range(TS.ListObject.DisplayName & "[" & Colonne & "]"), Méthode, Ordre
TS.ListObject.Sort.Apply
TS_TrierUneColonne = True
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_TrierUneColonne", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_TrierUneColonne"
End If
Err.Clear

Exit Function
Poser_Filtre:
TS.ListObject.Range.AutoFilter
Resume Next
 
End Function
'------------------------------------------------------------------------------------------------

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

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

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

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

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

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

' Si une colonne particulière est à analyser:
If IsMissing(Colonne) = True Then Colonne = ""
If Colonne <> "" Then
    ' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
    Colonne = TS_IndexColonne(TS, Colonne)
    If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
End If
 
' Boucle sur les filtres du tableau pour savoir s'ils sont actifs ou non:
With TS.ListObject.AutoFilter.Filters
    For f = 1 To .Count
        If .Item(f).On Then
            TS_Filtres_Existe = True
            Exit For
        End If
    Next
    ' S'il ne faut analyser qu'une seule colonne:
    If Val(Colonne) > 0 Then TS_Filtres_Existe = .Item(Colonne).On
End With
 
' Fin du traitement:
Gest_Err:
If Err.Number = 91 Then Err.Clear
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_Filtres_Existe", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_Filtres_Existe"
End If
Err.Clear

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

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_Filtres_Poser(TS As Range, _
                                 ByVal Colonne As Variant, _
                                 ByVal Critère1 As Variant, _
                                 Optional Opérateur As XlAutoFilterOperator, _
                                 Optional Critère2 As String = "") As Boolean
'------------------------------------------------------------------------------------------------
' Pose un filtre sur une colonne d'un Tableau Structuré.
' Pour plus d'informations :
' https://docs.microsoft.com/fr-fr/office/vba/api/excel.range.autofilter
' https://excel.developpez.com/faq/?page=Filtre
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Critère1 : le premier critère. Laissez à vide pour effacer le filtre
' Opérateur : l'opérateur logique.
' Critère2 : le second critère.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Exemples:
' TS_Filtres_Poser(range("TS_Eleves"),"Note",">10") pour les notes supérieures à 10.
' TS_Filtres_Poser(range("TS_Eleves"),"Nom","=m*", xlor, "=l*") pour les noms qui commencent par m ou l.
' TS_Filtres_Poser(range("TS_Eleves"),"Nom",Array("marx", "toto", "tini")) pour sélectionner certaines valeurs.
' TS_Filtres_Poser(range("TS_Eleves"),"Nom","") pour effacer le filtre sur le champ "Nom".
' Curieusement pour une date (à mettre au format année/mois/jour) il faut utiliser deux opérateurs,
' même pour filtrer un seul jour:
' TS_Filtres_Poser(range("TS_Eleves"),"Quand", ">=" & Year(Date) & "/" & Month(Date) & "/" & Day(Date), _
'                                       xlAnd, "<=" & Year(Date) & "/" & Month(Date) & "/" & Day(Date)
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
    
' Si c'est un Array qui est passé en Critère 1:
If IsArray(Critère1) = True Then
    TS.ListObject.Range.AutoFilter field:=Colonne, Criteria1:=Array(Critère1), Operator:=xlFilterValues
 
' Si les critères sont des chaînes de caractères:
Else
 
    ' S'il faut effacer un filtre:
    If Critère1 = "" Then Critère1 = Null
 
    ' S'il n'y a qu'un seul critère:
    If Critère2 = "" Then
        TS.ListObject.Range.AutoFilter field:=Colonne, Criteria1:=Critère1
    ' S'il y a deux critères:
    Else
        TS.ListObject.Range.AutoFilter field:=Colonne, Criteria1:=Critère1, Operator:=Opérateur, Criteria2:=Critère2
    End If
 
End If
 
TS_Filtres_Poser = True
    
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_Filtres_Poser", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_Filtres_Poser"
End If
Err.Clear

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_Filtres_Effacer(TS As Range, Optional Colonne As Variant) As Boolean
'------------------------------------------------------------------------------------------------
' Efface le filtre d'une colonne ou de toutes les colonnes d'un Tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne à effacer le filtre.
'           Si 0 alors efface le filtre de la dernière colonne du Tableau Structuré.
'           Si vide ou non renseigné alors efface tous les filtres.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' S'il faut effacer tous les filtres:
If IsMissing(Colonne) = True Then Colonne = ""
If Colonne = "" Then
    On Error Resume Next
    TS.ListObject.AutoFilter.ShowAllData
    Err.Clear
    TS_Filtres_Effacer = True
Else ' S'il faut effacer le filtre d'une colonne:
    If TS_Filtres_Poser(TS, Colonne, "") = False Then
        Err.Raise TS_Err_Number, , TS_Err_Description
    Else
        TS_Filtres_Effacer = True
    End If
End If
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_Filtres_Effacer", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_Filtres_Effacer"
End If
Err.Clear

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_Filtres_Mémoriser(TS As Range, Mémoire As Variant) As Boolean
'-----------------------------------------------------------------------------------------------
' Mémorise les filtres d'un Tableau Structuré.
'-----------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Mémoire : la mémoire à utiliser.
'-----------------------------------------------------------------------------------------------
' Renvoie : vrai si le tableau a au moins un filtre actif.
'-----------------------------------------------------------------------------------------------
Dim f As Integer
 
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Boucle sur les filtres du tableau:
With TS.ListObject.AutoFilter.Filters
    ReDim Mémoire(1 To .Count, 1 To 3)
    For f = 1 To .Count
        With .Item(f)
            If .On Then
                TS_Filtres_Mémoriser = True
                Mémoire(f, 1) = .Criteria1
                If .Operator Then
                    Mémoire(f, 2) = .Operator
                    Mémoire(f, 3) = .Criteria2
                End If
            End If
        End With
    Next
End With
 
' Fin du traitement:
Gest_Err:
Err.Clear

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_Filtres_Restaurer(TS As Range, Mémoire As Variant) As Boolean
'-----------------------------------------------------------------------------------------------
' Restaure les filtres d'un Tableau Structuré préalablement mémorisés avec TS_Filtres_Mémoriser.
'-----------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Mémoire : la mémoire à utiliser.
'-----------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'-----------------------------------------------------------------------------------------------
Dim f As Integer
 
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
For f = 1 To UBound(Mémoire, 1)
    If Not IsEmpty(Mémoire(f, 1)) Then
        If Mémoire(f, 2) Then
            TS.ListObject.Range.AutoFilter field:=f, _
                Criteria1:=Mémoire(f, 1), _
                Operator:=Mémoire(f, 2), _
                Criteria2:=Mémoire(f, 3)
        Else
            TS.ListObject.Range.AutoFilter field:=f, Criteria1:=Mémoire(f, 1)
        End If
    End If
Next
 
' Fin du traitement:
TS_Filtres_Restaurer = True

Gest_Err:
Err.Clear

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

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

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

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

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

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

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

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

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

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

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

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

' Renvoie VRAI:
TS_CouleurLigneChangeValeur = True

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

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

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

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

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

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

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_ValeurColonne(TS As Range, _
                                 ByVal Colonne As Variant, _
                                 TypeCalcul As XlTotalsCalculation, _
                                 CellulesVisiblesUniquement As Boolean) As Variant
'------------------------------------------------------------------------------------------------
' Renvoie la valeur d'une colonne.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' TypeCalcul : Type de calcul à appliquer suivant l'énumération XlTotalsCalculation.
'   xlTotalsCalculationAverage = Moyenne.
'   xlTotalsCalculationCount = Nombre de cellules non vides.
'   xlTotalsCalculationCountNums = Nombre de cellules avec des valeurs numériques.
'   xlTotalsCalculationMax = Valeur numérique maximale.
'   xlTotalsCalculationMin = Valeur numérique minimale.
'   xlTotalsCalculationStdDev = Écart type standard.
'   xlTotalsCalculationSum = Somme.
'   xlTotalsCalculationVar = (Personnalisé) Nombre de cellules non numériques.
'   xlTotalsCalculationNone = (personnalisé) Nombre de cellules vides.
' CellulesVisiblesUniquement : VRAI pour ne calculer que les cellules visibles.
'------------------------------------------------------------------------------------------------
' Renvoie : la valeur concernée en prenant en compte les lignes filtrées ou non, au choix,
'           ou Null si erreur (valeur non numérique).
'------------------------------------------------------------------------------------------------
Dim CalculationNone As Long
Dim CalculationVar As Long
Dim PlageCalcul As Range, Fx As Integer
Dim Ligne As Long
 
On Error GoTo Gest_Err
Err.Clear
 
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
 
' Par défaut renvoyer Null:
TS_ValeurColonne = Null
 
' S'il faut calculer les cellules visibles uniqement (non filtrées) pour les 7 opérateurs classiques,
' il est possible d'utiliser Application.Subtotal:
If CellulesVisiblesUniquement = True Then

    ' Définit la plage de calcul:
    Set PlageCalcul = TS.ListObject.ListColumns(Colonne).DataBodyRange
            
    Select Case TypeCalcul
        Case xlTotalsCalculationAverage:    Fx = 1
        Case xlTotalsCalculationCount:      Fx = 3
        Case xlTotalsCalculationCountNums:  Fx = 2
        Case xlTotalsCalculationMax:        Fx = 4
        Case xlTotalsCalculationMin:        Fx = 5
        Case xlTotalsCalculationStdDev:     Fx = 7
        Case xlTotalsCalculationSum:        Fx = 9
   End Select
    
    If Fx <> 0 Then TS_ValeurColonne = Application.Subtotal(Fx, PlageCalcul)
    
End If
 
' S'il faut calculer toutes les cellules (y compris les filtrées) pour les 7 opérateurs
' classiques, et xlTotalsCalculationNone, il est possible d'utiliser les fonctions "Application":
If CellulesVisiblesUniquement = False Then

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

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

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

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

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

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

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

On Error GoTo Gest_Err
Err.Clear

' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
 
' Contrôle la cohérence de la ligne passée en argument:
If Ligne >= 0 Then
    Ligne = TS_IndexLigne(TS, Ligne)
    If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
End If

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

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

' Restaure l'état de l'affichage des totaux:
If Ligne > TS.ListObject.ListRows.Count Then
    TS.ListObject.ShowTotals = Anc_ShowTotals
    Application.ScreenUpdating = Anc_ScreenUpdating
End If
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_InfoCellule", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_InfoCellule"
End If
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_Rechercher(TS As Range, _
                              RespecterCasse As Boolean, _
                              ParamArray ListeColonnesValeurs() As Variant) As Long
'-----------------------------------------------------------------------------------------------
' Recherche une valeur dans un Tableau Structuré.
'-----------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' RespecterCasse As Boolean : True pour respecter la casse ou False pour l'ignorer.
' ListeColonnesValeurs : La liste des colonnes et valeurs de type ParamArray (tableau de paramètres).
' Un ParamArray est limité à 32 arguments (séparés par une virgule), donc 16 couples.
'-----------------------------------------------------------------------------------------------
' Renvoie : la 1ère ligne trouvée ou 0 si rien n'est trouvé.
'------------------------------------------------------------------------------------------------
Dim i As Integer, Ligne As Long, ik As Integer, Trouvé As Boolean
Dim Arguments() As Variant
Dim Colonne() As Variant
Dim Valeur() As Variant
 
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Si ListeColonnesValeurs est passé en programmation:
If UBound(ListeColonnesValeurs) = 0 Then
    ReDim Arguments(LBound(ListeColonnesValeurs(0)) To UBound(ListeColonnesValeurs(0)))
    For ik = LBound(Arguments) To UBound(Arguments)
        Arguments(ik) = ListeColonnesValeurs(0)(ik)
    Next ik
End If
 
' Si ListeColonnesValeurs est passé en dure:
If UBound(ListeColonnesValeurs) > 0 Then
    ReDim Arguments(LBound(ListeColonnesValeurs) To UBound(ListeColonnesValeurs))
    For ik = LBound(Arguments) To UBound(Arguments)
        Arguments(ik) = ListeColonnesValeurs(ik)
    Next ik
End If
 
' Chargement des colonnes:
ik = LBound(Arguments)
For i = LBound(Arguments) To UBound(Arguments) Step 2
    ReDim Preserve Colonne(LBound(Arguments) To ik)
    Colonne(ik) = TS_IndexColonne(TS, Arguments(i))
    If Colonne(ik) = -1 Then Err.Raise vbObjectError, , TS_Err_Description
    ik = ik + 1
Next i
 
' Chargement des valeurs:
ik = LBound(Arguments)
For i = LBound(Arguments) To UBound(Arguments) Step 2
    ReDim Preserve Valeur(LBound(Arguments) To ik)
    Valeur(ik) = Arguments(i + 1)
    If TypeName(Arguments(i + 1)) <> "String" Then Valeur(ik) = CDec(Valeur(ik))
    ik = ik + 1
Next i

' Recherche dans toutes les lignes du Tableau Structuré les couples Colonne/valeur:
For Ligne = 1 To TS.ListObject.ListRows.Count
    
    Trouvé = True
    
    Select Case RespecterCasse
    Case True
        For i = LBound(Colonne) To UBound(Colonne)
            If TS.ListObject.DataBodyRange(Ligne, Colonne(i)).Value <> Valeur(i) Then
                Trouvé = False
                Exit For
            End If
        Next i
    
    Case False
        For i = LBound(Colonne) To UBound(Colonne)
            If UCase(TS.ListObject.DataBodyRange(Ligne, Colonne(i)).Value) <> UCase(Valeur(i)) Then
                Trouvé = False
                Exit For
            End If
        Next i
    End Select
    
    If Trouvé = True Then
        TS_Rechercher = Ligne
        Exit For
    End If
    
Next Ligne
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then
    If TS_Méthode_Err = TS_Générer_Erreur Then Err.Raise TS_Err_Number, "TS_Rechercher", TS_Err_Description
    If TS_Méthode_Err = TS_MsgBox_Erreur Then MsgBox TS_Err_Number & " : " & TS_Err_Description, vbInformation, "TS_Rechercher"
End If
Err.Clear

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