Microsoft 365 [RESOLU] Inventorier Pivot Table, Pivot Field et Pivot Item avec leur valeur

Heodrene

XLDnaute Occasionnel
Supporter XLD
Bonsoir à la Communauté,

Je souhaitais savoir s'il était faisable de créer une macro permettant de lister :
  • Les Pivot Tables
  • Les Pivot Fields
  • Les Pivot Items
    • Nom
    • Valeur
L'idée étant de partager des TCD avec d'autres utilisateurs mais de garder un référentiel de l'état et valeur des filtres paramétrés.
Pourquoi ? S'assurer que ce sont bien les bonnes données que l'on donne et prévenir une modification.

Merci de votre aide et suggestion :)

Heodrene
 

Heodrene

XLDnaute Occasionnel
Supporter XLD
Bonjour,

J'ai essayé d'avancer en m'inspirant très fortement d'algorithmes existants mais malheureusement, je suis un point de blocage avec une erreur suivante :
"Erreur d'exécution '13': Incompatibilité de type"

Erreur qui apparait à la ligne 92 (cf. pièce jointe) :

VB:
If pi.Visible Then strVis = "Y"

Si un expert a une idée / solution :)

Heodrene
 

Pièces jointes

  • Référentiel TCD.xlsm
    722.9 KB · Affichages: 2

Heodrene

XLDnaute Occasionnel
Supporter XLD
J'ai réussi à avoir ce que je voulais comme résultat :)

Voici le code pour ceusses que cela puissent intéresser :

VB:
Private Sub RéférentielTCD_Click()
' Procédure d'inventaire des filtres des TCD pour référence

    ' Déclaration des variables
    Dim sht As Worksheet ' Feuille du classeur
    Dim shtdst As Worksheet ' Feuille destination de l'inventaire
    Dim lRow As Long ' Lignes
    Dim lCols As Long ' Colonnes
    Dim bAll As Boolean ' Booléen de "Tout" affichage
    Dim strVis As String ' Etat de l'affichage visible ou pas de litem du PivotField
    Dim strPF As String ' Nom du PivotField
    Dim strPI As String ' Nom de l'item
    Dim strLoc As String ' Location du PivotField
    Dim strPTAddr As String ' Adresse du TCD
    Dim strPTName As String ' Nom du TCD
    Dim strSheetName As String ' Nom de la feuille
    Dim StrPFAddr As String ' Adresse du PivotField
    Dim lListItems As Long ' Liste des items
    Dim PFItems As Double ' Nombre d'items des PivotFields
    Dim strPFSourceName As String ' Source de la donnée
    Dim MaxItems As Double ' Nombre maximum d'items à inventorier
    
    ' Désactivation des alertes et notifications interactives
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
        
    ' Nombre de colonnes dans le tableau
    lCols = 9
    
    ' Dans ce classeur ...
    With ThisWorkbook
        
        '... Si la feuille "Référentiel TCD" existe (vérification via la fonction sheetExists)...
        If sheetExists("Référentiel TCD") = True Then
            '... Supression de la feuille existante ...
            .Worksheets("Référentiel TCD").Delete
            '... Puis création d'une nouvelle feuille à la fin du classeur
            .Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Référentiel TCD"
        ' Et si la feuille n'existe pas...
        Else
            ' ... La créer à la fin du classeur
            .Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Référentiel TCD"
        End If
        
        ' Définit la feuille destination comme étant la feuille "Référentiel TCD"
        Set shtdst = .Sheets("Référentiel TCD")
        
        ' Définition de la première ligne du tableau
        lRow = 1
            
        ' Dans la feuille destination...
        With shtdst
            ' ... Créer les différentes colonnes
            .Range(.Cells(lRow, 1), _
            .Cells(lRow, lCols)).Value = Array("Feuille - Nom", _
            "TCD - Name", _
            "TCD - Adresse", _
            "Location", _
            "Champ - Nom", _
            "Champ - Adresse", _
            "Champ - Source", _
            "Item", _
            "Visible")
            ' Mettre la ligne des étiquettes en gras
            .Rows(1).Font.Bold = True
        End With
        
        ' Incrémenter la ligne d'une pour passer à la suivante
        lRow = lRow + 1
        
        ' Définit le maximum d'items à inventorier au nombre de ligne possible dans la feuille
        MaxItems = Rows.Count
        
        ' Pour chaque feuille du classeur...
        For Each sht In .Worksheets
            strSheetName = sht.Name
            '... Pour chaque TCD de la feuille en cours...
            For Each pvt In sht.PivotTables
                ' Pour chaque PivotField du TCD en cours...
                For Each pvtField In pvt.PivotFields
                    ' ... Définir le type
                    Select Case pvtField.Orientation
                        Case xlPageField: strLoc = "1 - Filter"
                        Case xlRowField: strLoc = "2 - Row"
                        Case xlColumnField: strLoc = "3 - Column"
                        Case Else: strLoc = ""  'only list row, column, filter
                    End Select
                  
                    ' Si le type n'est pas vide...
                    If strLoc <> "" Then
                        ' Définit le nom du PivotField
                        strPF = pvtField.Name
                        ' Si le PivotField n'est pas "Valeurs" (ou "Values pour Excel version UK)
                        If strPF <> "Valeurs" Or strPF <> "Valeurs" Then
                            ' Définir le nom du TCD
                            strPTName = pvt.Name
                            ' Définir l'adresse du TCD
                            strPTAddr = pvt.TableRange2.Address
                            ' Définit la feuille du TCD
                            strSheetName = sht.Name
                            ' Définir la source de données du PivotField
                            strPFSourceName = pvtField.SourceName
                            ' Positionner la valeur booléanne du filtre Tous à Faux
                            bAll = False
                                
                            ' Si tous les PivotFields ne sont pas visibles, positionner le filtre d'affichage Tous à vrai
                            If pvtField.AllItemsVisible Then bAll = True
                    
                            ' Définit le nombre d'items
                            PFItems = pvtField.PivotItems.Count
                            lListItems = vbYes
                            
                            If lListItems = vbYes Then
                                ' Pour chaque item des PivotFileds...
                                For Each PvtItem In pvtField.PivotItems
                                    ' Définit sa visibilité...
                                    strVis = ""
                                    '... Son nom...
                                    strPI = PvtItem.Name
                                    '... Son adresse
                                    StrPFAddr = pvtField.LabelRange.Address
                        
                                    ' Si l'item est "blank" (vide)...
                                    If strPI <> "(blank)" Then
                                        '... Et si le nom du PivotField est Valeurs (ou Values en version UK)
                                        If strPF <> "Valeurs" Or strPF <> "Values" Then
                                            ' Dans le cas où le filtre d'affichage...
                                            Select Case bAll
                                                ' ... Est vrai...
                                                Case True
                                                    '... Sa visibilité est à Oui
                                                    strVis = "Y"
                                                ' Sinon
                                                Case Else
                                                    '... Si la visibilité est à faux alors la mettre à Oui
                                                    If PvtItem.Visible Then strVis = "Y"
                                            End Select
                        
                                            ' Dans la feuille de destination...
                                            With shtdst
                                                '... Renseigner chaque colonne
                                                .Range(.Cells(lRow, 1), _
                                                .Cells(lRow, lCols)).Value = Array(strSheetName, _
                                                strPTName, _
                                                strPTAddr, _
                                                strLoc, _
                                                strPF, _
                                                StrPFAddr, _
                                                strPFSourceName, _
                                                strPI, _
                                                strVis)
                                            End With
                            
                                            ' Incrémenter la ligne d'une pour passer à la suivante
                                            lRow = lRow + 1
                                        End If
                                    End If
                                ' Passer à l'item suivant
                                Next PvtItem
                            Else
                                strPI = PFItems & " Items"
                                Select Case bAll
                                    Case True: strVis = "Y"
                                    Case Else: strVis = "N/A"
                                End Select
                        
                                ' Dans la feuille de destination
                                With shtdst
                                    ' Renseigner les informations dans chaque colonne
                                    .Range(.Cells(lRow, 1), _
                                    .Cells(lRow, lCols)).Value = Array(strSheetName, _
                                    strPTName, _
                                    strPTAddr, _
                                    strLoc, _
                                    strPF, _
                                    StrPFAddr, _
                                    strPFSourceName, _
                                    strPI, _
                                    strVis)
                                End With
                                    
                                ' Incrémenter la ligne d'une pour passer à la suivante
                                lRow = lRow + 1
                            End If
                        End If
                    End If
                ' Passer au prochain PivotField
                Next pvtField
            ' Passer au prochain TCD
            Next pvt
        ' Passer à la prochaine feuille
        Next sht
        
        ' Mettre les données au format d'un tableau
        With shtdst
          .ListObjects.Add(xlSrcRange, .Range("A1").CurrentRegion, , xlYes).Name = "tblFltr_" & Format(Now(), "mmddhhmmss")
          .Range(.Cells(1, 1), .Cells(1, lCols)) _
          .EntireColumn.AutoFit
          .Range("A1").CurrentRegion.Sort Key1:=.Range("A2"), Order1:=xlAscending, Header:=xlYes
        End With
    End With
    
    ' Activation des alertes et notifications interactives
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    
End Sub
 

Statistiques des forums

Discussions
311 725
Messages
2 081 947
Membres
101 849
dernier inscrit
florentMIG