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

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

'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_ConvertirPlageEnTS")
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_CréerUnTableau")
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerLeTableau")
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éclanchée si le nom n'existe pas:
If TypeName(Colonne) = "String" Then Colonne = TS.ListObject.ListColumns(Colonne).Index

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

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

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

'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_ChangerLibellé")
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_EffacerUneLigne")
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_EffacerToutesLignes")
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_AjouterUneLigne")
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerUneLigne")
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerPlusieursLignes")
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerToutesLignes")
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
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then TS_SupprimerLignesVisibles = -1
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerLignesVisibles")
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------

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

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

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

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

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

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

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

' Fin du traitement, renvoie -1 en cas d'erreur:
Gest_Err:
If Err.Number = 1004 Then Err.Clear
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then TS_SupprimerLignesMasquées = -1
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerLignesMasquées")
Err.Clear

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

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

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

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

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

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

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

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

' Fin du traitement, renvoie -1 en cas d'erreur:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then TS_SupprimerDoublons = -1
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_SupprimerDoublons")
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ù inserer une nouvelle colonne.
'           Si vide ou 0 alors ajoute une colonne à la fin du tableau.
' Nom = Le nom de la nouvelle colonne.
'       Si vide alors Excel attribuera un nom d'office et Nom sera alimenté.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une colonne a été ajoutée.
'------------------------------------------------------------------------------------------------
Dim i As Integer

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

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

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

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

Select Case Colonne
 
    Case 0 ' Ajoute une colonne à la suite du tableau:
        TS.ListObject.ListColumns.Add.Name = Nom
        Nom = TS.ListObject.ListColumns(TS.ListObject.ListColumns.Count).Name
        TS.ListObject.HeaderRowRange(TS.ListObject.ListColumns.Count).NumberFormat = "@"
        TS_AjouterUneColonne = True
        
    Case Else ' Ajoute une colonne dans le tableau:
        TS.ListObject.ListColumns.Add(Colonne).Name = Nom
        Nom = TS.ListObject.ListColumns(Colonne).Name
        TS.ListObject.HeaderRowRange(Colonne).NumberFormat = "@"
        TS_AjouterUneColonne = True
        
End Select
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_AjouterUneColonne")
Err.Clear

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

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

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

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

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

End If

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

TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_DéplacerColonne")
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é.
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear
 
Select Case Ligne_Entête
    Case True: TS.ListObject.ShowHeaders = True
    Case False: TS.ListObject.ShowHeaders = False
                TS.ListObject.ShowAutoFilterDropDown = False
End Select
 
Select Case Ligne_Totaux
    Case True: TS.ListObject.ShowTotals = True
    Case False: TS.ListObject.ShowTotals = False
End Select
 
Select Case Ligne_Bandes
    Case True: TS.ListObject.ShowTableStyleRowStripes = True
    Case False: TS.ListObject.ShowTableStyleRowStripes = False
End Select
 
Select Case Première_Colonne
    Case True: TS.ListObject.ShowTableStyleFirstColumn = True
    Case False: TS.ListObject.ShowTableStyleFirstColumn = False
End Select
 
Select Case Dernière_Colonne
    Case True: TS.ListObject.ShowTableStyleLastColumn = True
    Case False: TS.ListObject.ShowTableStyleLastColumn = False
End Select
 
Select Case Colonne_Bandes
    Case True: TS.ListObject.ShowTableStyleColumnStripes = True
    Case False: TS.ListObject.ShowTableStyleColumnStripes = False
End Select
 
On Error GoTo Poser_Filtre
Select Case Bouton_Filtre
    Case True: TS.ListObject.ShowHeaders = True
               TS.ListObject.ShowAutoFilterDropDown = True
    Case False: TS.ListObject.ShowAutoFilterDropDown = False
End Select
On Error GoTo 0

If StyleTableau <> "/" Then
    Sheets(TS.Parent.Name).ListObjects(TS.ListObject.DisplayName).TableStyle = StyleTableau
End If
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number = 0 Then TS_OptionsStyle = True
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_OptionsStyle")
Err.Clear

Exit Function

Poser_Filtre:
TS.ListObject.Range.AutoFilter
Resume Next

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

'------------------------------------------------------------------------------------------------
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é.
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear
 
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
 
' Affiche les totaux et pose le calcul:
TS.ListObject.ShowTotals = True
TS.ListObject.ListColumns(Colonne).TotalsCalculation = TypeCalcul
TS_DéfinirTotaux = True
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_DéfinirTotaux")
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------
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, _
                                 FormatNumérique As String) As Boolean
'------------------------------------------------------------------------------------------------
' Définit le format d'une colonne (valable aussi sur les lignes masquées).
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' FormatNumérique : Le format à appliquer à la colonne.
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
' Exemples avec un tableau structuré nommé "Tableau1":
' Pour mettre la dernière colonne en date : Call TS_FormatColonne(Range("Tableau1"), 0, "dd/mm/yyyy")
' Et pour la mettre en numérique sans virgule : Call TS_FormatColonne(Range("Tableau1"), 0, "0")
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear
 
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
 
' Pose le format:
TS.ListObject.ListColumns(Colonne).DataBodyRange.NumberFormat = FormatNumérique

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

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

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

' S'il faut effacer tous les anciens tris ou juste
' le tri sur la colonne concerné pour pouvoir en mettre un nouveau:
If EffacerAncienTri = True Then
    Call TS_EffacerTri(TS, "")
Else
    Call TS_EffacerTri(TS, Colonne)
End If
  
' Pose le tri sur la colonne:
TS.ListObject.Sort.SortFields.Add Range(TS.ListObject.DisplayName & "[" & Colonne & "]"), Méthode, Ordre
TS.ListObject.Sort.Apply

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

Exit Function

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

‘------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_EffacerTri")
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Filtres_Effacer")
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é.
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear
 
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
    
' Si c'est un Array qui est passé en Critère 1:
If IsArray(Critère1) = True Then
    TS.ListObject.Range.AutoFilter Field:=Colonne, Criteria1:=Array(Critère1), Operator:=xlFilterValues
 
' Si les critères sont des chaînes de caractères:
Else
 
    ' S'il faut effacer un filtre:
    If Critère1 = "" Then Critère1 = Null
 
    ' S'il n'y a qu'un seul critère:
    If Critère2 = "" Then
        TS.ListObject.Range.AutoFilter Field:=Colonne, Criteria1:=Critère1
    ' S'il y a deux critères:
    Else
        TS.ListObject.Range.AutoFilter Field:=Colonne, Criteria1:=Critère1, Operator:=Opérateur, Criteria2:=Critère2
    End If
 
End If
 
TS_Filtres_Poser = True
    
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Filtres_Poser")
Err.Clear

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

'------------------------------------------------------------------------------------------------
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é.
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear
 
' S'il faut effacer tous les filtres:
If IsMissing(Colonne) = True Then Colonne = ""
If Colonne = "" Then
    On Error Resume Next
    TS.ListObject.AutoFilter.ShowAllData
    Err.Clear
    TS_Filtres_Effacer = True
Else ' S'il faut effacer le filtre d'une colonne:
    If TS_Filtres_Poser(TS, Colonne, "") = False Then
        Err.Raise TS_Err_Number, , TS_Err_Description
    Else
        TS_Filtres_Effacer = True
    End If
End If
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Filtres_Effacer")
Err.Clear

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

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

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

'------------------------------------------------------------------------------------------------
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 struturé à chaque changement de valeur dans la
' colonne de votre choix. Ou supprime toutes les couleurs des lignes visibles.
' Le tableau doit avoir au moins deux lignes.
'------------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si 0 alors prend la dernière colonne du Tableau Structuré.
'           Si vide ou -1 (valeur par défaut) alors efface toutes les couleurs des lignes visibles.
' CoulA : La première couleur à appliquer (sans couleur par défaut).
' CoulB : La seconde couleur à appliquer (sans couleur par défaut).
'------------------------------------------------------------------------------------------------
' Renvoie : Vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim y As Long
Dim AncValeur As Variant
Dim Coul As Long
Dim Anc_ScreenUpdating As Boolean
Dim Anc_Cursor As Long

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

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

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

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

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

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

' Renvoie VRAI:
TS_CouleurLigneChangeValeur = True

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

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

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

'------------------------------------------------------------------------------------------------
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 = (Personalisé) Nombre de cellules non numériques.
'   xlTotalsCalculationNone = (personnalisé) Nombre de cellules vides.
' CellulesVisiblesUniquement : VRAI pour ne calculer que les cellules visibles.
'------------------------------------------------------------------------------------------------
' Renvoie : la valeur concernée en prenant en compte les lignes filtrées ou non, au choix,
'           ou Null si erreur (valeur non numérique).
'------------------------------------------------------------------------------------------------
Dim CalculationNone As Long
Dim CalculationVar As Long
Dim PlageCalcul As Range, Fx As Integer
Dim Ligne As Long
 
On Error GoTo Gest_Err
Err.Clear
 
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
 
' Par défaut renvoyer Null:
TS_ValeurColonne = Null
 
' S'il faut calculer les cellules visibles uniqement (non filtrées) pour les 7 opérateurs classiques,
' il est possible d'utiliser Application.Subtotal:
If CellulesVisiblesUniquement = True Then

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

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

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

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

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

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

'------------------------------------------------------------------------------------------------
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 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_InfoCellule")
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 IsNumeric(Valeur(ik)) = True Then Valeur(ik) = CDec(Valeur(ik))
    ik = ik + 1
Next i

' Recherche dans toutes les lignes du Tableau Structuré les couples Colonne/valeur:
For Ligne = 1 To TS.ListObject.ListRows.Count
    
    Trouvé = True
    
    Select Case RespecterCasse
    Case True
        For i = LBound(Colonne) To UBound(Colonne)
            If TS.ListObject.DataBodyRange(Ligne, Colonne(i)).Value <> Valeur(i) Then
                Trouvé = False
                Exit For
            End If
        Next i
    
    Case False
        For i = LBound(Colonne) To UBound(Colonne)
            If UCase(TS.ListObject.DataBodyRange(Ligne, Colonne(i)).Value) <> UCase(Valeur(i)) Then
                Trouvé = False
                Exit For
            End If
        Next i
    End Select
    
    If Trouvé = True Then
        TS_Rechercher = Ligne
        Exit For
    End If
    
Next Ligne
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Rechercher")
Err.Clear

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_RechercherVisible(TS As Range, _
                                     ByVal Colonne As Variant, _
                                     ValeurCherchée As Variant, _
                                     RespecterCasse As Boolean, _
                                     ValeursOuFormules As Enum_ValeursOuFormules) As Long
'-----------------------------------------------------------------------------------------------
' Recherche une valeur dans une colonne d'un Tableau Structuré uniquement pour les lignes visibles
' et renvoie la ligne trouvée.
' La recherche respecte la casse si RespecterCasse = True.
'-----------------------------------------------------------------------------------------------
' TS : La plage du Tableau Structuré.
' Colonne : Le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' ValeurCherchée : La valeur recherchée.
' RespecterCasse As Boolean : True pour respecter la casse ou False pour l'ignorer.
' ValeursOuFormules : énumération Enum_ValeursOuFormules =
'                     TS_Valeurs : en valeurs.
'                     TS_Formules : en formules.
'-----------------------------------------------------------------------------------------------
' Renvoie : Le numéro de la 1ère ligne trouvée ou 0 si rien n'est trouvé.
'------------------------------------------------------------------------------------------------
' Remarque : voir la documentation sur "Find" pour plus d'informations.
' https://learn.microsoft.com/fr-fr/office/vba/api/excel.xlfindlookin
'------------------------------------------------------------------------------------------------
Dim Rg As Range
Dim Lookin As Long

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

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

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

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

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

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

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

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

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

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

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

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

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

'------------------------------------------------------------------------------------------------
Public Function TS_Sélectionner(TS As Range, _
                                Optional ByVal Colonne As Variant = "", _
                                Optional ByVal Ligne As Variant) As Boolean
'------------------------------------------------------------------------------------------------
' Sélectionne une plage dans un tableau Structuré.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne
'           Si 0 alors prend la dernière colonne du Tableau Structuré.
'           Si non renseigné alors sélectionne la ligne entière renseignée.
' Ligne : la ligne concernée.
'         Si 0 alors prend la dernière ligne du Tableau Structuré.
'         Si <0 alors prend la ligne des totaux.
'         Si non renseigné alors sélectionne la colonne entière renseignée.
' Si Colonne et Ligne ne sont pas renseignée alors sélectionne toutes les données.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si une sélection a été faite.
'------------------------------------------------------------------------------------------------
' Gestion des erreurs:
On Error GoTo Gest_Err
Err.Clear
 
' Si la colonne et la ligne ne sont pas renseignées alors sélectionne toutes les données:
If Colonne = "" And IsMissing(Ligne) = True Then
    TS.ListObject.DataBodyRange.Select
    TS_Sélectionner = True
    GoTo Gest_Err
End If
 
' Si la ligne n'est pas renseignée:
If IsMissing(Ligne) = True Then Ligne = ""
If Ligne = "" Then
    ' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
    Colonne = TS_IndexColonne(TS, Colonne)
    If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
    ' Sélectionner toutes les données de la colonne:
    TS.ListObject.ListColumns(Colonne).DataBodyRange.Select
    TS_Sélectionner = True
    ' Quitte le traitement:
    GoTo Gest_Err
End If
 
' Si la ligne est 0 alors prend la dernière ligne:
If Ligne = 0 Then Ligne = TS.ListObject.ListRows.Count
 
' Si colonne est vide alors sélectionne toute la ligne:
If Colonne = "" Then
    ' La ligne du tableau:
    If Ligne > 0 And Ligne <= TS.ListObject.ListRows.Count Then
        TS.ListObject.ListRows(Ligne).Range.Select
        TS_Sélectionner = True
    End If
    ' La ligne des totaux:
    If Ligne < 0 Then
        TS.ListObject.ShowTotals = True
        TS.ListObject.TotalsRowRange.Select
        TS_Sélectionner = True
    End If
    ' Quitte le traitement:
    GoTo Gest_Err
End If
 
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
 
' Deux cas de sélection possibles:
If Ligne < 0 Then ' Sélectionne juste le total.
    TS.ListObject.ShowTotals = True
    TS.ListObject.Range(TS.ListObject.ListRows.Count + 2, Colonne).Select
    TS_Sélectionner = True
Else ' Sélectionne une cellule:
    Ligne = TS_IndexLigne(TS, CLng(Ligne))
    If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
    TS.ListObject.Range(Ligne + 1, Colonne).Select
    TS_Sélectionner = True
End If
 
' Fin du traitement:
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Sélectionner")
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------

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

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

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

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

' Si la colonne et la ligne ne sont pas renseignées alors renvoie toutes les données:
If Colonne = "" And IsMissing(Ligne) = True Then
    Set r = TS.ListObject.DataBodyRange
    GoTo Gest_Err
End If
 
' Si la ligne n'est pas renseignée:
If IsMissing(Ligne) = True Then Ligne = ""
If Ligne = "" Then
    ' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
    Colonne = TS_IndexColonne(TS, Colonne)
    If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
    ' Renvoie toutes les données de la colonne:
    Set r = TS.ListObject.ListColumns(Colonne).DataBodyRange
    ' Quitte le traitement:
    GoTo Gest_Err
End If
 
' Si la ligne est 0 alors prend la dernière ligne:
If Ligne = 0 Then Ligne = TS.ListObject.ListRows.Count
 
' Si colonne est vide alors renvoie toute la ligne:
If Colonne = "" Then
    ' La ligne du tableau:
    If Ligne > 0 And Ligne <= TS.ListObject.ListRows.Count Then
        Set r = TS.ListObject.ListRows(Ligne).Range
    End If
    ' La ligne des totaux:
    If Ligne < 0 Then
        TS.ListObject.ShowTotals = True
        Set r = TS.ListObject.TotalsRowRange
    End If
    ' Quitte le traitement:
    GoTo Gest_Err
End If
 
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
 
' Deux cas de renvois possibles:
If Ligne < 0 Then ' Renvoie juste le total.
    TS.ListObject.ShowTotals = True
    Set r = TS.ListObject.Range(TS.ListObject.ListRows.Count + 2, Colonne)
Else ' Renvoie une cellule:
    Ligne = TS_IndexLigne(TS, CLng(Ligne))
    If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
    Set r = TS.ListObject.Range(Ligne + 1, Colonne)
End If
 
' Fin du traitement:
Gest_Err:

' S'il faut ou non ne prendre que les cellules visibles:
If Not r Is Nothing Then
    If VisibleUniquement = True Then
        Set TS_Range = r.SpecialCells(xlCellTypeVisible)
    Else
        Set TS_Range = r
    End If
End If

TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 And TS_MasqueMsgBox = False Then _
    MsgBox Err.Number & " : " & Err.Description, vbCritical + vbOKOnly, IIf(TS_MsgBoxTitre <> "", TS_MsgBoxTitre, "TS_Range")
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------