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

'------------------------------------------------------------------------------------------------
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 : (valeur par défaut) la plage contient des en-têtes;
'              xlNo : la plage ne contient pas d'en-tête et Excel les rajoute;
'              xlGuess : Excel détecte automatiquement si la plage contient ou non des en-têtes.
'------------------------------------------------------------------------------------------------
' Renvoie : la plage Range qui représente la plage du Tableau Structuré créé.
'------------------------------------------------------------------------------------------------
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
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() 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.
' 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 de type Range qui représente le Tableau Structuré créé.
'------------------------------------------------------------------------------------------------
' 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
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
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 incluse 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 incluse 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
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
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
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
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
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
 
' 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
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 :
TS.ListObject.DataBodyRange.Delete
TS_SupprimerToutesLignes = True
 
' Fin du traitement :
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
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:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then TS_SupprimerLignesVisibles = -1
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
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(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
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
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
 
Select Case Bouton_Filtre
    Case True: TS.ListObject.ShowHeaders = True
               TS.ListObject.ShowAutoFilterDropDown = True
    Case False: TS.ListObject.ShowAutoFilterDropDown = False
End Select

If StyleTableau <> "/" Then
    Sheets(TS.Parent.Name).ListObjects(TS.ListObject.DisplayName).TableStyle = StyleTableau
End If
 
' Fin du traitement:
Gest_Err:
If Err.Number = 0 Then TS_OptionsStyle = True
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
Err.Clear
 
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
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
TS.ListObject.ShowAutoFilterDropDown = True

' S'il faut effacer tous les anciens tris ou juste
' le tri sur la colonne concerné pour pouvoir en mettre un nouveau :
If EffacerAncienTri = True Then
    Call TS_EffacerTri(TS, "")
Else
    Call TS_EffacerTri(TS, Colonne)
End If
  
' Pose le tri sur la colonne :
TS.ListObject.Sort.SortFields.Add Range(TS.ListObject.DisplayName & "[" & Colonne & "]"), Méthode, Ordre
TS.ListObject.Sort.Apply
TS_TrierUneColonne = True
 
' Fin du traitement :
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If TS_TrierUneColonne = False And (Colonne < 0 Or Colonne > TS.ListObject.ListColumns.Count) Then _
    TS_Err_Description = "La colonne [" & Colonne & "] n'est pas incluse dans le tableau."
Err.Clear
 
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
    TS.ListObject.Sort.SortFields.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
TS_EffacerTri = True
 
' 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
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
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
    TS.ListObject.AutoFilter.ShowAllData
    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
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 
'-----------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------
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
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
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, Colonne() As Variant, 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 dur :
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
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
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_ModifCellule(Tableau, "Note", 0, 15)
Call TS_ModifCellule(Tableau, "Note", 0, 2, TS_Ajouter)
Call TS_ModifCellule(Tableau, "Note", 0, True, TS_Gras)
Call TS_ModifCellule(Tableau, "Note", 0, 255, TS_CouleurTexte)
Call TS_ModifCellule(Tableau, "Note", 0, "De gros efforts réalisés.", TS_Commentaire, 120, 20)
End Sub
'------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Call TS_ModifCellule(Tableau, "Note", -1, "=SUM(TS_Eleves[Note])/COUNT(TS_Eleves[Note])", TS_Formule)
End Sub
'------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------
Public Function TS_ModifCellule(TS As Range, _
                                ByVal Colonne As Variant, _
                                ByVal Ligne As Long, _
                                Valeur As Variant, _
                                Optional TypeInfo As Enum_InfoTS = TS_Valeur, _
                                Optional LargeurCommentaire As Long = 0, _
                                Optional HauteurCommentaire As Long = 0) As Boolean
'------------------------------------------------------------------------------------------------
' Modifie une information sur la cellule même si elle est masquée.
' L'information peut être la valeur ou la formule ou la couleur du texte...
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' Colonne : le numéro de la colonne, ou le nom de la colonne.
'           Si vide ou 0 alors prend la dernière colonne du Tableau Structuré.
' Ligne : la ligne concernée.
'         Si 0 alors prend la dernière ligne du Tableau Structuré.
'         Si <0 alors prend la ligne des totaux.
' Valeur : la valeur à appliquer.
' TypeInfo : Type d'information à modifier, voir l'énumération Enum_InfoTS
'            TS_Valeur : Modifie la valeur qui prend la valeur passée dans Valeur.
'            TS_Ajouter : Ajoute à la valeur existante la valeur passée dans Valeur.
'            TS_Soustraire : Soustrait à la valeur existante la valeur passée dans Valeur.
'            TS_Multiplier : Multiplie la valeur existante par la valeur passée dans Valeur.
'            TS_Diviser : Divise la valeur existante par la valeur passée dans Valeur.
'            TS_Formule : Modifie la formule qui devient la formule passée dans Valeur.
'            TS_CouleurTexte : Modifie la couleur de texte qui prend la valeur passée dans Valeur.
'            TS_CouleurFond : Modifie la couleur de fond qui prend la valeur passée dans Valeur.
'                             Si valeur est vide alors efface la couleur de fond.
'            TS_Gras : Si Valeur vaut Vrai alors met la cellule est en gras.
'            TS_Italique : Si Valeur vaut Vrai alors met la cellule est en italique.
'            TS_Format : Modifie le format de la cellule.
'            TS_Commentaire : Modifie le commentaire (vide pour l'effacer).
'            TS_ImageCommentaireJPG : Modifie l'image "jpg" d'un commentaire (vide pour l'effacer).
'            TS_LienHypertexte : Modifie le lien Hypertexte de la cellule (vide pour l'effacer).
' LargeurCommentaire : Largeur du commentaire, ou 0 pour la taille par défaut.
' HauteurCommentaire : Hauteur du commentaire, ou 0 pour la taille par défaut.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
On Error GoTo Gest_Err
Err.Clear
 
' Si le tableau est vierge alors il faut l'initialiser (doit être dans le classeur actif):
If TS.ListObject.ListRows.Count = 0 And (Ligne = 0 Or Ligne = 1) Then
    Call TS_AjouterUneLigne(TS, 0)
End If
 
' Retrouve le numéro de la colonne et vérifie sa cohérence (ou -1 si erreur):
Colonne = TS_IndexColonne(TS, Colonne)
If Colonne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
 
' Deux cas de modification possibles :
If Ligne < 0 Then ' Ligne des totaux :
    Ligne = TS.ListObject.ListRows.Count + 1
    TS.ListObject.ShowTotals = True
Else ' Ligne du taleau :
    Ligne = TS_IndexLigne(TS, Ligne)
    If Ligne = -1 Then Err.Raise vbObjectError, , TS_Err_Description
End If

' Modifie la cellule suivant le type demandé :
With TS.ListObject.DataBodyRange(Ligne, Colonne)
Select Case TypeInfo
    Case TS_Valeur
        .Value = Valeur
    Case TS_Ajouter
        .Value = .Value + Valeur
    Case TS_Soustraire
        .Value = .Value - Valeur
    Case TS_Multiplier
        .Value = .Value * Valeur
    Case TS_Diviser
        .Value = .Value / Valeur
    Case TS_Formule
        .Formula = Valeur
    Case TS_CouleurTexte
        .Font.Color = Valeur
    Case TS_CouleurFond
        If IsNumeric(Valeur) = True Then .Interior.Color = Valeur
        If Valeur = "" Then .Interior.Pattern = xlNone
    Case TS_Gras
        If Valeur = True Then .Font.Bold = True
        If Valeur = False Then .Font.Bold = False
    Case TS_Italique
        If Valeur = True Then .Font.Italic = True
        If Valeur = False Then .Font.Italic = False
    Case TS_Format
        .NumberFormat = Valeur
    Case TS_Commentaire
        .ClearComments
        If Valeur <> "" Then
            .AddComment
            .Comment.Text Text:=Valeur
            If HauteurCommentaire > 0 Then .Comment.Shape.Height = HauteurCommentaire
            If LargeurCommentaire > 0 Then .Comment.Shape.Width = LargeurCommentaire
        End If
    Case TS_ImageCommentaireJPG
        .ClearComments
        If Valeur <> "" Then
            .AddComment
            .Comment.Shape.Fill.UserPicture Valeur
            If HauteurCommentaire > 0 Then .Comment.Shape.Height = HauteurCommentaire
            If LargeurCommentaire > 0 Then .Comment.Shape.Width = LargeurCommentaire
        End If
    Case TS_LienHypertexte
        .Hyperlinks.Delete
        If Valeur <> "" Then
            .Hyperlinks.Add Anchor:=TS.ListObject.DataBodyRange(Ligne, Colonne), Address:=Valeur
        End If
End Select
End With
 
' Fin du traitement :
Gest_Err:
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number = 0 Then TS_ModifCellule = True
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
Dim Tableau As Range
Set Tableau = Range("TS_Eleves")
Dim TD As Range
Set TD = Range("Données")

' Efface les éventuels filtres sur le tableau des données à importer :
Call TS_Filtres_Effacer(TD)

‘ Importe les données suivant les clés Nom et Prénom, renvoie False en cas d’erreur et l’affiche :
If TS_ImporterDonnées(Tableau, TD, TS_MAJ_Ou_Ajout, False, "Nom", "prénom") = False Then
    MsgBox TS_Err_Number & " : " & TS_Err_Description, vbCritical, "Erreur de traitement"
End If 

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

'------------------------------------------------------------------------------------------------
Public Function TS_ImporterDonnées(TS As Range, _
                                   TD As Range, _
                                   Méthode As Enum_ImportationTS, _
                                   RespecterCasse As Boolean, _
                                   ParamArray ListeColonnesClés() As Variant) As Boolean
'------------------------------------------------------------------------------------------------
' Permet l'importation de données depuis un Tableau Structuré pour alimenter
' le Tableau Structuré d'origine.
' Toutes les colonnes du tableau d'origine qui ont une correspondance dans le tableau qui contient
' les données à importer sont traitées.
'------------------------------------------------------------------------------------------------
' ATTENTION : les lignes masquées du Tableau Structuré qui contient les données à importer
' ~~~~~~~~~~  ne sont pas importées. Ce qui permet (éventuellement) de faire en amont une règle
'             de gestion des importations.
'------------------------------------------------------------------------------------------------
' TS : le Tableau Structuré d'origine.
' TD : le Tableau Structuré qui contient les données à importer.
' Méthode : la méthode d'importation
'           TS_Ajout_Forcé : Ajoute les lignes au tableau d'origine même si elles existent déjà, dans
'                            ce cas mettre "" pour ListeColonnesClés.
'           TS_MAJ_Uniquement : Ne fait que des mises à jour et refuse les ajouts.
'           TS_MAJ_Ou_Ajout : Fait une mise à jour si possible ou un ajout si la donnée est nouvelle.
'           TS_IgnorerSiExiste : Ne tient pas compte de la donnée si elle existe déjà.
' RespecterCasse As Boolean : True pour respecter la casse ou False pour l'ignorer.
' ListeColonnesClés : la liste des colonnes (en-tête) qui sert de clé de référence dans la comparaison
'                     des mises à jour, de type ParamArray (tableau de paramètres).
'                     Passez en argument soit le nom soit le numéro de la colonne.
'                     Un ParamArray est limité à 32 arguments, séparés par une virgule.
'------------------------------------------------------------------------------------------------
' Renvoie : vrai si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim x As Integer, i As Integer, y As Long, yy As Long, NomColonne As String
Dim Ajout As Boolean
Dim Arguments() As Variant
Dim NbClé As Integer
Dim MesFiltres As Variant
 
' Gestion des erreurs :
On Error GoTo Gest_Err
Err.Clear
 
' Mémorise les éventuels filtres et les retire :
Call TS_Filtres_Mémoriser(TS, MesFiltres)
Call TS_Filtres_Effacer(TS)
 
' S'il y a des colonnes renseignées pour former une clé :
If IsMissing(ListeColonnesClés) = False Then
    NbClé = (UBound(ListeColonnesClés) + 1) * 2
    ReDim Arguments(1 To NbClé)
    x = 1
    For i = 0 To UBound(ListeColonnesClés)
        Arguments(x) = ListeColonnesClés(i)
        If IsNumeric(Arguments(x)) = True Then _
            Arguments(x) = TS.ListObject.ListColumns(Arguments(x)).Name
        x = x + 2
    Next i
End If
 
' Boucle sur les lignes du Tableau Structuré à importer :
For y = 1 To TD.ListObject.ListRows.Count

    Ajout = False
    yy = 0
    
    ' Si la ligne est masquée alors passer à la suivante :
    If TD.ListObject.DataBodyRange(y, 1).Height = 0 Then GoTo Suite_Y

    ' Si une recherche sur les titres :
    If NbClé > 0 And Méthode <> TS_Ajout_Forcé Then
        
        For i = 2 To NbClé Step 2
            ' Renvoie la valeur de la colonne clé :
            Arguments(i) = TS_InfoCellule(TD, Arguments(i - 1), y, TS_Valeur)
            ' Si la clé n'exite pas:
            If TS_Err_Number <> 0 Then Err.Raise TS_Err_Number, , TS_Err_Description
        Next i
        
        ' Si la clé est trouvée dans le tableau destination alors ne pas
        ' ajouter une ligne mais travailler sur la ligne trouvée = yy.
        ' La recherche tient compte de la casse ou non :
        yy = TS_Rechercher(TS, RespecterCasse, Arguments)
        If yy <> 0 Then Ajout = True
        If TS_Err_Number <> 0 Then Err.Raise TS_Err_Number, , TS_Err_Description
        
        ' Si l'on ne doit faire que des mises à jour alors passer à la suite
        ' si la donnée n'est pas trouvée dans le tableau destination :
        If Méthode = TS_MAJ_Uniquement And yy = 0 Then GoTo Suite_Y
        
        ' Si l'on doit ignorer les données qui existe déjà alors passer
        ' à la suite si la donnée est trouvée dans le tableau destination :
        If Méthode = TS_IgnorerSiExiste And yy <> 0 Then GoTo Suite_Y
    
    End If
    
    ' Boucle sur les colonnes :
    For x = 1 To TD.ListObject.ListColumns.Count
        ' Récupère le nom de la colonne :
        NomColonne = TD.ListObject.HeaderRowRange(x).Value
        ' S'il faut ajouter une ligne :
        If Ajout = False Then
            Ajout = True
            TS.ListObject.ListRows.Add
            yy = 0
        End If
        ' Ajoute la donnée au tableau destination :
        Call TS_ModifCellule(TS, NomColonne, yy, TD.ListObject.DataBodyRange(y, x).Value, TS_Valeur)
    Next x
    
Suite_Y:
Next y
 
' Restaure les filtres et l'affichage :
Call TS_Filtres_Restaurer(TS, MesFiltres)
 
' Fin du traitement :
Gest_Err:
If Err.Number = 0 Then TS_ImporterDonnées = True
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
Err.Clear

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

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

' Suppression de l'éventuel ancien tableau (erreur générée si Range("Tableau_Noms") n’existe pas):
On Error Resume Next
Set TS_Destination = Range("Tableau_Noms")
Call TS_SupprimerLeTableau(TS_Destination)

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

' Création du tableau sans doublon :
Set TS_Destination = TS_CréerUnTableau(Plage:=ThisWorkbook.Sheets("Feuil2").Range("A1"), _
                           Titres:="Nom", _
                           Nom:="Tableau_Noms", _
                           Style:="*")

' Importation des données sans doublons
If TS_ImporterDonnées(TS_Destination, Tableau, TS_MAJ_Ou_Ajout, True, "Nom") = False Then
    Err.Raise TS_Err_Number, , TS_Err_Description
End If

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

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

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

'------------------------------------------------------------------------------------------------
Sub Exemple()
'------------------------------------------------------------------------------------------------
If TS_ExporterEnFichier(Range("TS_Eleves"), TS_PDF, "P:\Fichier\Tableau_Eleves.pdf", True) = False Then
    MsgBox TS_Err_Number & " : " & TS_Err_Description, vbCritical, "Erreur de conversion en PDF"
End If
'------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------
Public Function TS_ExporterEnFichier(TS As Range, _
                                     FormatFichier As Enum_ExportationTS, _
                                     ByVal FichierDest As String, _
                                     OuvrirFichier As Boolean) As Boolean
'------------------------------------------------------------------------------------------------
' Exporte un Tableau Structuré du classeur actif en fichier au format XLSX, CSV, BMP, JPG, PDF.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' FormatFichier : le format de fichier à générer, voir l'énumération Enum_ExportationTS
'               TS_XLSX : fichier Excel.
'               TS_CSV : fichier texte au format CSV, séparateur point-virgule (ne prend pas les lignes masquées).
'               TS_BMP : fichier image au format BMP.
'               TS_JPG : fichier image au format JPG.
'               TS_PDF : fichier au format "Portable Document Format" PDF.
' FichierDest : le chemin destination (qui doit exister) et le nom du fichier à créer,
'               si un fichier existait déjà il est remplacé.
' OuvrirFichier : Si VRAI alors ouvre le fichier généré.
'------------------------------------------------------------------------------------------------
' Renvoie : VRAI si tout s'est bien passé.
'------------------------------------------------------------------------------------------------
Dim Repertoire As String, Sh As Worksheet
Dim Filtre As String
Dim Tmp As String, FileNumber As Long, ol As Range, oC As Range
Dim Anc_ScreenUpdating As Boolean
Dim Anc_Visible As Integer
Dim ObjPicture As Object
Dim Rng As Range

On Error GoTo Gest_Err
Err.Clear
 
' Mémorise la feuille active:
Set Sh = ActiveSheet
  
' Force la mise à jour de l'écran:
Anc_ScreenUpdating = Application.ScreenUpdating
Application.ScreenUpdating = True

' Sélection de la feuille et de la plage:
Anc_Visible = Sheets(TS.Parent.Name).Visible
Sheets(TS.Parent.Name).Visible = True
Sheets(TS.Parent.Name).Activate
Set Rng = TS.ListObject.Range

' Le fichier destination doit être renseigné:
If FichierDest = "" Then Err.Raise vbObjectError, , "Le fichier destination doit être renseigné."

' Le répertoire doit exister:
Repertoire = Left(FichierDest, InStrRev(FichierDest, "\"))
If CreateObject("Scripting.FileSystemObject").Folderexists(Repertoire) = False Then _
    Err.Raise vbObjectError, , "Le dossier de destination " & Repertoire & " n'est pas présent."

' Traitements suivant le type de fichier à générer:
Application.Cursor = xlWait
Select Case FormatFichier

Case TS_CSV
    
    ' Contrôle la présence de l'extension et supprime le fichier existant:
    If UCase(Right(FichierDest, 4)) <> ".CSV" Then FichierDest = FichierDest & ".csv"
    If Dir(FichierDest) <> "" Then Kill FichierDest
    
    ' Ajustement des colonnes pour ne pas avoir de # quand elles sont trop petites:
    TS.Cells.EntireColumn.AutoFit
    
    ' Création d'un fichier:
    FileNumber = FreeFile
    Open FichierDest For Output As #FileNumber
    
    ' Boucle sur les lignes:
    For Each ol In Rng.Rows
        ' Boucle sur les cellules de la ligne:
        Tmp = ""
        ' Si la ligne n'est pas masquée:
        If ol.Height <> 0 Then
            ' Boucle sur les colonnes:
            For Each oC In ol.Cells
                Tmp = Tmp & CStr(oC.Text) & ";"
            Next
            ' Ne pas prendre le dernier séparateur:
            Tmp = Left(Tmp, Len(Tmp) - 1)
            ' Ecriture dans le fichier:
            Print #FileNumber, Tmp
        End If
    Next
    Close #FileNumber

Case TS_XLSX
    
    ' Contrôle la présence de l'extension et supprime le fichier existant:
    If UCase(Right(FichierDest, 5)) <> ".XLSX" Then FichierDest = FichierDest & ".xlsx"
    If Dir(FichierDest) <> "" Then Kill FichierDest
    
    ' Copie le Tableau Structuré:
    TS.ListObject.Range.Copy

    ' Ouvre une instance Excel et un classeur:
    Dim AppXl As Excel.Application
    Set AppXl = CreateObject("excel.application")
    AppXl.Visible = False
    AppXl.Workbooks.Add

    ' Y copie le Tableau Structuré en plage:
    AppXl.ActiveSheet.Paste

    ' Converti la plage en Tableau Structuré:
    Call TS_ConvertirPlageEnTS(AppXl.ActiveSheet.Range("A1"), TS.ListObject.DisplayName, TS.Parent.ListObjects(TS.ListObject.Name).TableStyle, xlYes)
    AppXl.ActiveSheet.Range("A1").Select

    ' Sauvegarde le fichier et ferme l'instance:
    AppXl.ActiveWorkbook.SaveAs FichierDest
    AppXl.ActiveWorkbook.Close
    Set AppXl = Nothing

Case TS_PDF
    
    ' Contrôle la présence de l'extension et supprime le fichier existant:
    If UCase(Right(FichierDest, 4)) <> ".PDF" Then FichierDest = FichierDest & ".pdf"
    If Dir(FichierDest) <> "" Then Kill FichierDest
    
    ' Création d'un fichier au format PDF:
    Rng.ExportAsFixedFormat xlTypePDF, FichierDest
    
Case TS_BMP, TS_JPG
    
    ' Contrôle la présence de l'extension et supprime le fichier existant:
    If FormatFichier = TS_BMP Then
        If UCase(Right(FichierDest, 4)) <> ".BMP" Then FichierDest = FichierDest & ".bmp"
        Filtre = "BMP"
    End If
    If FormatFichier = TS_JPG Then
        If UCase(Right(FichierDest, 4)) <> ".JPG" Then FichierDest = FichierDest & ".jpg"
        Filtre = "JPG"
    End If
    If Dir(FichierDest) <> "" Then Kill FichierDest
    
    ' Copie les cellules dans le Presse-papiers en tant qu'image:
    Rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    
    ' Création d'un objet image (de petite taille mais elle sera ajustée):
    Set ObjPicture = Rng.Parent.ChartObjects.Add(10, 10, 10, 10)
    DoEvents
    With ObjPicture
        .ShapeRange.Line.Visible = msoFalse                      ' Masque l'objet.
        DoEvents
        .Height = Rng.Height                                     ' Ajuste la hauteur.
        .Width = Rng.Width                                       ' Ajuste la largeur.
        DoEvents
        .Chart.Paste                                             ' Colle le presse-papiers
        DoEvents
        .Chart.Export Filename:=FichierDest, Filtername:=Filtre  ' Exporte l'image
        .Delete                                                  ' Supprime l'objet.
    End With

Case Else
    
    Err.Raise vbObjectError, , "Le type d'exportation demandé n'est pas géré."
    
End Select

' Renvoie Vrai:
TS_ExporterEnFichier = True

' Fin du traitement:
Gest_Err:
Sh.Activate
Application.ScreenUpdating = Anc_ScreenUpdating
Sheets(TS.Parent.Name).Visible = Anc_Visible
Application.Cursor = xlDefault
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
Err.Clear
 
' S'il faut ouvrir le fichier:
If TS_ExporterEnFichier = True And OuvrirFichier = True _
    Then Call Shell("Explorer.exe " & FichierDest, vbMaximizedFocus)
 
End Function
'------------------------------------------------------------------------------------------------

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

' Suppression de l'éventuel ancien tableau :
On Error Resume Next
Set TS_Destination = Range("Tableau_Noms")
Call TS_SupprimerLeTableau(TS_Destination)

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

' Création du tableau structuré :
Set TS_Destination = TS_CréerUnTableau(Plage:=ThisWorkbook.Sheets("Feuil2").Range("A1"), _
                           Titres:="Nom", _
                           Nom:="Tableau_Noms", _
                           Style:="*")
                           
' Requête pour obtenir la liste des noms sans doublon et triée :
Set Enr = TS_RequeteSQL(Tableau, "[Nom]", "GROUP BY [Nom] ORDER BY [Nom]")

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

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

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

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

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

'------------------------------------------------------------------------------------------------
...

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

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

' Place des totaux :
Call TS_ModifCellule(TS_Destination, "Note", -1, "Nb élèves :", TS_Valeur)
Call TS_DéfinirTotaux(TS_Destination, "Quantité", xlTotalsCalculationSum)

...
'------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------
...
   
' Requête pour obtenir les notes inférieures à 10 :
Set Enr = TS_RequeteSQL(Tableau, "[Note]", "WHERE [Note] < 10")

' Boucle sur le jeu d’enregistrements pour ajouter 1 à la note :
If Not Enr Is Nothing Then
    While Enr.EOF = False
        Enr.Fields(0).Value = Enr.Fields(0).Value + 1 ' Ajoute 1 à la valeur.
        Enr.Update                                    ' Valide la modification.
        Enr.MoveNext                                  ' Passe à l'enregistrement suivant.
    Wend
End If

...
'------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------
Public Function TS_RequeteSQL(TS As Range, StrChamps As String, _
                              Optional ByVal StrSQL As String = "") As Variant
'------------------------------------------------------------------------------------------------
' Sélectionne les données d'un tableau de données EXCEL (ou une plage avec en-tête)
' et alimente TS_RequeteSQL des enregistrements correspondants à la requête.
' TS : le tableau Structuré (ou la plage avec en-tête). Maxi = 65535 lignes et 255 colonnes. A1:IU65535
' StrChamps : Liste des champs (ou * ou vide pour tous).
' StrSQL : Requête SQL avec ses conditions.
'------------------------------------------------------------------------------------------------
' Renvoie : le jeu d'enregistrements sélectionné,
'           ou Nothing si rien n'est sélectionné (ou erreur).
'------------------------------------------------------------------------------------------------
' Gestion des erreurs :
On Error GoTo Gest_Err
Err.Clear

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

' Pour faire une sélection dans un Tableau Structuré il faut la ligne d'en-tête,
' et supprimer les totaux pour ne pas les renvoyer :
Dim Anc_Entete As Boolean
Dim Anc_Totaux As Boolean
Dim Anc_ScreenUpdating As Boolean
 
Anc_Entete = TS.ListObject.ShowHeaders
Anc_Totaux = TS.ListObject.ShowTotals
Anc_ScreenUpdating = Application.ScreenUpdating
 
Application.ScreenUpdating = False
TS.ListObject.ShowHeaders = True
TS.ListObject.ShowTotals = False

' Requête sur le tableau de données passé en argument (ou la plage avec en-tête)
StrSQL = "SELECT " & IIf(StrChamps > "", StrChamps, "*") & " FROM [" & TS.Parent.Name & "$" _
         & TS.CurrentRegion.Address(False, False, xlA1) & "] " & StrSQL
 
' S'il y a des enregistrements concernés alors les renvoie :
Set TS_RequeteSQL = TS_ExecuterSQL(TS, StrSQL)
 
' Restaure l'affichage :
TS.ListObject.ShowHeaders = Anc_Entete
TS.ListObject.ShowTotals = Anc_Totaux
Application.ScreenUpdating = Anc_ScreenUpdating
 
' Fin du traitement :
Gest_Err:
If Err.Number <> 0 Then
    TS_Err_Number = Err.Number
    TS_Err_Description = Err.Description
    TS_RequeteSQL = Nothing
End If
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------

'------------------------------------------------------------------------------------------------
Private Function TS_ExecuterSQL(TS As Range, StrSQL As String) As Variant ' => ADODB.Recordset
'------------------------------------------------------------------------------------------------
' Exécute une requête au format SQL.
'------------------------------------------------------------------------------------------------
' TS : la plage du Tableau Structuré.
' StrSQL : la requête.
'------------------------------------------------------------------------------------------------
' La liaison anticipée nécessite d'installer la référence : Microsoft ActiveX Data Objects 6.0 Library
' La liaison tardive permet de ne pas référencer la bibliothèque ADO.
' L’instanciation d’objets à l’aide de la liaison tardive est généralement plus lente
' que l’utilisation de la liaison anticipée.
' Ici la liaison tardive a été adoptée uniquement pour vous éviter d'installer manuellement une
' référence et donc simplifier la portabilité du code.
' Les remarques ci-dessous indiquent comment adapter le code pour une liaison anticipée.
'------------------------------------------------------------------------------------------------
' Provider et Extended à utiliser :
' Soit Microsoft.Jet.OLEDB.4.0 et Excel 8.0
' Soit Microsoft.ACE.OLEDB.12.0 et Excel 12.0 (voire Excel 14.0)
'------------------------------------------------------------------------------------------------
Dim Cnn As Variant  ' Liaision anticipée => As ADODB.Connection
Dim Rs As Variant   ' Liaision anticipée => As ADODB.Recordset
 
' Gestion des erreurs :
On Error GoTo Gest_Err
Err.Clear
Set TS_ExecuterSQL = Nothing

' Création d'une connexion :
Set Cnn = CreateObject("ADODB.Connection") ' Liaision anticipée => Set Cnn = New ADODB.Connection
Cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
         "Data Source=" & TS.Worksheet.Parent.FullName & ";" & _
         "Extended Properties=""Excel 12.0;HDR=Yes"";"
 
' Exécute une requête SQL sur un jeu d'enregistrements :
Set Rs = CreateObject("ADODB.Recordset") ' Liaision anticipée => Set Rs = New ADODB.Recordset
Rs.Open StrSQL, Cnn, 1, 2, 1 ' Liaision anticipée => adOpenKeyset, adLockPessimistic, adCmdText
 
' S'il y a des enregistrements concernés :
If Rs.EOF = False Then
    Rs.MoveFirst             ' Replace le pointeur au début du jeu d'enregistrements (facultatif).
    Set TS_ExecuterSQL = Rs  ' Renvoie les enregistrements.
End If
 
' Fin du traitement, libération des mémoires :
Gest_Err:
Set Rs = Nothing
Set Cnn = Nothing
TS_Err_Number = Err.Number
TS_Err_Description = Err.Description
If Err.Number <> 0 Then Set TS_ExecuterSQL = Nothing
Err.Clear
 
End Function
'------------------------------------------------------------------------------------------------