EXCEL :: VBA :: Activer - Désactiver les filtres dans un tableau en plage d'adresses ou dans un tableau structuré

oguruma · Jeudi à 21:23

Bonjour le Forum,
Sujet abordé de nombreuses fois sur le net avec beaucoup de questions et aussi avec le .showalldata qui ne fonctione pas toujours (ou ne fonctionnait pas toujours) dans certaines versions d'Excel - eg en v2010 c'était un peu la loterie 🙂
J'ai revu certaines de mes fonctions qui semblent bien fonctionner... à défauts des tests que j'aurai loupé

Voici le code des différentes fonctions implémentées avec un fichier joint vous permettant de les tester

Juste un petit arrêt sur cette fonction qui est un peu méthode bourrin par cette ligne de code où on va récupérer la plage d'adresses du tableau structuré pour se positionner au début du tableau et ainsi on a accès aux fonctionnalités du Menu Données pour intervenir sur les filtres et on blinde le non plantage par un On Error Resume Next.
Ceci avait été mon contournement en Excel V2010 pour ne pas être ennuyé par le .ShowAllData et les propriétés associées aux filtres.

On se positionne au début du tableau structuré comme ceci

VB:

 Range(Split(wk.ListObjects(hTS).DataBodyRange.Address, ":")(0)).Activate

On force le passage par

VB:

    On Error Resume Next
    wk.ShowAllData

VB:

Range(Split(wk.ListObjects(hTS).DataBodyRange.Address, ":")(0)).Activate

VB:

Sub SHOWALLDATA_TS_V1(hTS As String, Optional hWK As String = "ActiveSheet")
    Dim wk As Worksheet
    
    If Not exitsWK(hWK) And hWK <> "ActiveSheet" Then
        MsgBox "L'onglet " & hWK & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If
    
    If hWK = "ActiveSheet" Then Set wk = ActiveSheet Else Set wk = ActiveWorkbook.Worksheets(hWK)
    
    If Not exitsTS(hTS) Then
        MsgBox "Le tableau " & hTS & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If
    
    Range(Split(wk.ListObjects(hTS).DataBodyRange.Address, ":")(0)).Activate
    
    On Error Resume Next
    wk.ShowAllData

End Sub

SOURCES

VB:

Option Explicit

Sub POSITIONNER_FILTRES_AREA()
    On Error Resume Next
    ActiveSheet.Range("$B$6:$H$26").AutoFilter Field:=1, Criteria1:="LEGUME"
    ActiveSheet.Range("$B$6:$H$26").AutoFilter Field:=7, Criteria1:="ESPAGNE"
End Sub

Sub POSITIONNER_FILTRES_TS()
    On Error Resume Next
    ActiveSheet.ListObjects("TB_DATA").Range.AutoFilter Field:=1, Criteria1:= _
        "LEGUME"
    ActiveSheet.ListObjects("TB_DATA").Range.AutoFilter Field:=7, Criteria1:= _
        "FRANCE"
End Sub

'============================================================================
' Liste de modules pour la gestion des taleaux structurés
'============================================================================

Sub TEST_SHOWALLDATA_TS_V1()
    Call SHOWALLDATA_TS_V1("TB_DATA", "Feuil2")
End Sub

Sub SHOWALLDATA_TS_V1(hTS As String, Optional hWK As String = "ActiveSheet")
    Dim wk As Worksheet
    
    If Not exitsWK(hWK) And hWK <> "ActiveSheet" Then
        MsgBox "L'onglet " & hWK & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If
    
    If hWK = "ActiveSheet" Then Set wk = ActiveSheet Else Set wk = ActiveWorkbook.Worksheets(hWK)
    
    If Not exitsTS(hTS) Then
        MsgBox "Le tableau " & hTS & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If
    
    Range(Split(wk.ListObjects(hTS).DataBodyRange.Address, ":")(0)).Activate
    
    On Error Resume Next
    wk.ShowAllData

End Sub


Sub TEST_SHOWALLDATA_TS_V2()
    SHOWALLDATA_TS_V2 ("TB_DATA")
End Sub


Sub SHOWALLDATA_TS_V2(hTS As String)
    If Not exitsTS(hTS) Then
        MsgBox "Le tableau " & hTS & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If
    With Range(hTS).ListObject
      If Not .AutoFilter Is Nothing _
        Then .AutoFilter.ShowAllData
    End With
End Sub

Sub TEST_SHOWALLDATA_TS_V3()
    Call SHOWALLDATA_TS_V3("TB_DATA")
End Sub

Sub SHOWALLDATA_TS_V3(hTS As String)
    Dim oTbl As ListObject
    
    If Not exitsTS(hTS) Then
        MsgBox "Le tableau " & hTS & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If

    Set oTbl = Range(hTS).ListObject
    If Not oTbl.AutoFilter Is Nothing Then oTbl.AutoFilter.ShowAllData
    
End Sub

Sub TEST_SHOWALLDATA_TS_V4()
    Call SHOWALLDATA_TS_V4("TB_DATA")
End Sub

Sub SHOWALLDATA_TS_V4(hTS As String, Optional hWK As String = "ActiveSheet")
    Dim wk As Worksheet

    If Not exitsWK(hWK) And hWK <> "ActiveSheet" Then
        MsgBox "L'onglet " & hWK & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If

    If hWK = "ActiveSheet" Then Set wk = ActiveSheet Else Set wk = ActiveWorkbook.Worksheets(hWK)

    If Not exitsTS(hTS) Then
        MsgBox "Le tableau " & hTS & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If

    With wk.ListObjects(hTS)
        If .ShowAutoFilter Then .AutoFilter.ShowAllData
    End With
    
End Sub

Sub TEST_SHOWALLDATA_TS_V5()
    Call SHOWALLDATA_TS_V5("TB_DATA")
End Sub

Sub SHOWALLDATA_TS_V5(hTS As String, Optional hWK As String = "ActiveSheet")
    Dim oTbl As ListObject
    Dim wk As Worksheet
    
    If Not exitsWK(hWK) And hWK <> "ActiveSheet" Then
        MsgBox "L'onglet " & hWK & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If

    If Not exitsTS(hTS) Then
        MsgBox "Le tableau " & hTS & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If
    
    If hWK = "ActiveSheet" Then Set wk = ActiveSheet Else Set wk = ActiveWorkbook.Worksheets(hWK)
    
    Set oTbl = wk.ListObjects(hTS)
    If oTbl.ShowAutoFilter Then oTbl.AutoFilter.ShowAllData
    
End Sub

Sub TEST_ACTIVER_FILTRE_TS()
    Call ACTIVER_FILTRE_TS("TB_DATA")
End Sub

Sub ACTIVER_FILTRE_TS(hTS As String)

    Dim oTbl As ListObject
    
    If Not exitsTS(hTS) Then
        MsgBox "Le tableau " & hTS & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If
    
    Set oTbl = Range(hTS).ListObject
    
    On Error Resume Next
    If oTbl.AutoFilter Is Nothing Then Range(hTS).AutoFilter
    
End Sub

Sub TEST_DESACTIVER_FILTRE_TS()
    Call DESACTIVER_FILTRE_TS("TB_DATA")
End Sub

Sub DESACTIVER_FILTRE_TS(hTS As String)

    Dim oTbl As ListObject
    
    If Not exitsTS(hTS) Then
        MsgBox "Le tableau " & hTS & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If
    
    Set oTbl = Range(hTS).ListObject
    
    On Error Resume Next
    If Not oTbl.AutoFilter Is Nothing Then Range(hTS).AutoFilter
    
End Sub

'============================================================================
' Liste de modules pour la gestion des taleaux en plages de données
'============================================================================

Sub TESTER_ALL_DATA_ADDRESS_1()
    Call SHOW_ALL_DATA_ADDRESS
End Sub

Sub TESTER_ALL_DATA_ADDRESS_2()
    Call SHOW_ALL_DATA_ADDRESS("Feuil1")
End Sub

Sub SHOW_ALL_DATA_ADDRESS(Optional hWK As String = "ActiveSheet")
    Dim wkActive As Worksheet
    Dim wk As Worksheet

    If Not exitsWK(hWK) And hWK <> "ActiveSheet" Then
        MsgBox "L'onglet " & hWK & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If

    Set wkActive = ActiveSheet
    If hWK = "ActiveSheet" Then Set wk = ActiveSheet Else Set wk = Worksheets(hWK)
    wk.Activate
    If wk.FilterMode Then
        wk.ShowAllData
    End If
    wkActive.Activate
End Sub

Sub TESTER_DESACTIVER_FILTRE_ADDRESS_1()
    Call DESACTIVER_FILTRE_ADDRESS("TABLE_DATA")
End Sub

Sub TESTER_DESACTIVER_FILTRE_ADDRESS_2()
    Call DESACTIVER_FILTRE_ADDRESS("TABLE_DATA", "Feuil1")
End Sub

Sub DESACTIVER_FILTRE_ADDRESS(hRange As String, Optional hWK As String = "ActiveSheet")
    Dim wkActive As Worksheet
    Dim rRange As Range
    Dim wk As Worksheet
    
    If Not exitsWK(hWK) And hWK <> "ActiveSheet" Then
        MsgBox "L'onglet " & hWK & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If
    
    Set wkActive = ActiveSheet
    If hWK = "ActiveSheet" Then Set wk = ActiveSheet Else Set wk = Worksheets(hWK)
    wk.Activate
    Set rRange = Range(hRange)
    If wk.AutoFilterMode Then
        rRange.AutoFilter
    End If
    wkActive.Activate

End Sub

Sub TESTER_ACTIVER_FILTRE_ADDRESS_1()
    Call ACTIVER_FILTRE_ADDRESS("TABLE_DATA")
End Sub

Sub TESTER_ACTIVER_FILTRE_ADDRESS_2()
    Call ACTIVER_FILTRE_ADDRESS("TABLE_DATA", "Feuil1")
End Sub

Sub ACTIVER_FILTRE_ADDRESS(hRange As String, Optional hWK As String = "ActiveSheet")
    Dim wkActive As Worksheet
    Dim rRange As Range
    Dim wk As Worksheet
    
    If Not exitsWK(hWK) And hWK <> "ActiveSheet" Then
        MsgBox "L'onglet " & hWK & " est inconnu", vbCritical, "existsTS"
        Exit Sub
    End If
    
    Set wkActive = ActiveSheet
    If hWK = "ActiveSheet" Then Set wk = ActiveSheet Else Set wk = Worksheets(hWK)
    wk.Activate
    Set rRange = Range(hRange)
    If Not wk.AutoFilterMode Then
        rRange.AutoFilter
    End If
    
    wkActive.Activate

End Sub

et sources de quelques fonctions pour vérifier la présence d'un tableau structuré, d'un onglet, d'un champ nommé.... ça peut servir dans d'autres développements

VB:

Option Explicit


Function existsRANGE(hRange As String) As Boolean
    Dim wb As Workbook
    Dim v As Name
    existsRANGE = False
    Set wb = ActiveWorkbook
    For Each v In wb.Names
        If v.Name = hRange Then
            existsRANGE = True
            Exit Function
        End If
    Next
End Function


Function exitsTS(hTS As String) As Boolean
    Dim wb As Workbook
    Dim wk As Worksheet
    Dim obj As ListObject
    Set wb = ActiveWorkbook
    exitsTS = False
    For Each wk In wb.Worksheets
        For Each obj In wk.ListObjects
            If hTS = obj.Name Then
                exitsTS = True
                Exit Function
            End If
        Next
    Next
End Function

Function exitsWK(hWK As String) As Boolean
    Dim wb As Workbook
    Dim wk As Worksheet
    Dim obj As ListObject
    Set wb = ActiveWorkbook
    exitsWK = False
    For Each wk In wb.Worksheets
        If hWK = wk.Name Then
            exitsWK = True
            Exit Function
        End If
    Next
End Function

Effectuez une recherche sur Excel Downloads...

EXCEL :: VBA :: Activer - Désactiver les filtres dans un tableau en plage d'adresses ou dans un tableau structuré

oguruma

XLDnaute Occasionnel

Pièces jointes

Discussions similaires

Nous accordons de l'importance à votre vie privée