Nettoyage des Tableaux croisés

[chasseur44]

SAlut à tous Tout le monde connait cette Macro permettant de nettoyer les TCD :
Sub

Macro_nettoyage_tableau_croisé_dynamic()

'Effacer les etiquettes des champs des tableaux croisés dynamiques

Dim ws As Worksheet
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Integer

On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
For Each pt In ws.PivotTables
pt.RefreshTable
For Each pf In pt.PivotFields
For Each pi In pf.PivotItems
If pi.RecordCount = 0 And _
Not pi.IsCalculated Then
pi.Delete
End If
Next
Next
Next
Next
End Sub​

Cette macro parcourt tous les TCD du Fichier ouvert.
Comment faire pour le faire uniquement sur la feuille active !
Merci de votre aide

 

[tototiti2008]

Re : Nettoyage des Tableaux croisés

Bonjour chasseur44,

[FONT=Book Antiqua][SIZE=1]Sub [/SIZE][/FONT][SIZE=1][COLOR=blue]Macro_nettoyage_tableau_croisé_dynamic()[/COLOR][/SIZE]
 
[SIZE=1][COLOR=blue]'Effacer les etiquettes des champs des tableaux croisés dynamiques[/COLOR][/SIZE]
 
[SIZE=1][COLOR=blue]Dim pt As PivotTable[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]Dim pf As PivotField[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]Dim pi As PivotItem[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]Dim i As Integer[/COLOR][/SIZE]
 
[SIZE=1][COLOR=blue]On Error Resume Next[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]For Each pt In Activesheet.PivotTables[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]pt.RefreshTable[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]For Each pf In pt.PivotFields[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]For Each pi In pf.PivotItems[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]If pi.RecordCount = 0 And _[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]Not pi.IsCalculated Then[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]pi.Delete[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]End If[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]Next[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]Next[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]Next[/COLOR][/SIZE]
[SIZE=1][COLOR=blue]End Sub[/COLOR][/SIZE]

Edit : Bonsoir Pierrot, Bonne nuit bhbh 😉

 

[Pierrot93]

Re : Nettoyage des Tableaux croisés

Bonjour Chasseur,

modifie peut être ainsi, non testé....

Sub Macro_nettoyage_tableau_croisé_dynamic()
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Integer

On Error Resume Next
For Each pt In ActiveSheet.PivotTables
    pt.RefreshTable
    For Each pf In pt.PivotFields
        For Each pi In pf.PivotItems
            If pi.RecordCount = 0 And _
                Not pi.IsCalculated Then
                pi.Delete
            End If
        Next
    Next
Next
End Sub

bonne soirée
@+

Edition : bonsoir Toto, bhbh

 

[Cousinhub]

Re : Nettoyage des Tableaux croisés

Bonjour,

si tu as excel 2002 ou ultérieur, tu peux également utiliser ce code :

Sub supprime_anciens_items()
'Excel 2002 et ultérieurs
Dim pvt As PivotTable
For Each pvt In ActiveSheet.PivotTables
    pvt.PivotCache.MissingItemsLimit = xlMissingItemsNone
    pvt.PivotCache.Refresh
Next pvt
End Sub

sinon, pour les versions antérieurres :

' Published by Debra Dalgleish 21 Juin 2003
'
'======================
Sub DeleteOldItemsWB()
'gets rid of unused items in PivotTable
' based on MSKB (202232)
Dim pt As PivotTable
Dim pf As PivotField
Dim pi As PivotItem
Dim i As Integer

On Error Resume Next
    For Each pt In ActiveSheet.PivotTables
        pt.RefreshTable
        For Each pf In pt.PivotFields
            For Each pi In pf.PivotItems
                If pi.RecordCount = 0 And _
                   Not pi.IsCalculated Then
                    pi.Delete
                End If
            Next
        Next
    Next
End Sub

Bonne journée

 

[chasseur44]

Re : Nettoyage des Tableaux croisés

Merci cela marche et en plus j'ai compris les modifs faites 😛
Génial ce forum 😱

 

[chasseur44]

Re : Nettoyage des Tableaux croisés

Re bonjour
J'ai testé la première méthode fourni ; effectivement cela marche, après des tests appronfondis je me suis apperçu que cela me virait certains liens hypertextes ?
J'ai restesté avec le script original et cela fait la même chose.
Indicatio : mon fichier est assez lourds ! est-ce qu'à un môment, il y a pas un problème de mémoire ! sachant que mon fichier tourne environ une bonne heure pour nettoyer les différents filtres !

Merci pour votre aide

 

[chasseur44]

Re : Nettoyage des Tableaux croisés

Quelqu'un a t'il une solution SVP 😱