Opgelost Reser slicer alleen voor 1 tabbladf

[Jurgen2807]

Dag allen,

Ik heb een vraag. Ik heb een groot bestand gemaakt waar op diverse tabbladen slicers staan.

Nu heb ik een formulierbesturingselement toegevoegd met een Macro erachter. Echter als ik op de knop reset filters klik, dan worden de filters van alle tabbladen gereset. Zie bijlage als voorbeeld.

Ik wil graag een besturingselement waar alleen de slicers gereset worden van de pagina waarop het besturingselement staat.

Wie kan mij helpen?

Code die ik heb gevonden is. In die code wordt ook verwezen naar het gehele Excel werkboek. Graag jullie hulp:

Public Sub Reset_filters()
' Rest_filters
Application.ScreenUpdating = False 'Switch off screen updating for performance
' Declare single Slicer Cache type variable
Dim cache As SlicerCache
' Cycle through each cache in whole Excel workbook and clear any manual filter applied
For Each cache In ActiveWorkbook.SlicerCaches
cache.ClearManualFilter
Next cache
ActiveSheet.Range("D20").Select
' Switch back on screen updating
Application.ScreenUpdating = True
End Sub

 

[edmoor]

Wijzig ActiveWorkbook in Activesheet.

 

[Jurgen2807]

Wijzig ActiveWorkbook in Activesheet.

Dat werkt niet. Dan krijg ik een foutmelding; ook in het voorbeeldbestand.

 

[edmoor]

Maak er dan dit van:

Public Sub Reset_filters()
    Dim slcr As SlicerCache
    Dim slc As Slicer
    
    Application.ScreenUpdating = False
    
    For Each slcr In ActiveWorkbook.SlicerCaches
        For Each slc In slcr.Slicers
           If slc.Shape.Parent Is ActiveSheet Then
              If slcr.FilterCleared = False Then
                 slcr.ClearManualFilter
                 Exit For
              End If
           End If
        Next slc
    Next slcr
    
    Application.ScreenUpdating = True
End Sub

 

[Jurgen2807]

Maak er dan dit van:

Public Sub Reset_filters()
    Dim slcr As SlicerCache
    Dim slc As Slicer
   
    Application.ScreenUpdating = False
   
    For Each slcr In ActiveWorkbook.SlicerCaches
        For Each slc In slcr.Slicers
           If slc.Shape.Parent Is ActiveSheet Then
              If slcr.FilterCleared = False Then
                 slcr.ClearManualFilter
                 Exit For
              End If
           End If
        Next slc
    Next slcr
   
    Application.ScreenUpdating = True
End Sub

En deze werkt perfect. Dank voor je hulp. Wordt enorm gewaardeerd.