Le cache de données des tableaux croisés dynamiques

Function CacheIndexTCD(rngTCD As Range) As Long
  CacheIndexTCD = rngTCD.PivotTable.CacheIndex
End Function

Sub InfosCacheTCD()
  ' Objectif    : Génération d'une nouvelle feuille dans le classeur actif contenant des informations
  '                sur les tableaux/graphiques dynamiques.
  ' Utilisation : Activer le classeur puis exécuter la macro.
  ' Retour      : Une nouvelle feuille contenant les informations.
  ' Auteur      : Arnaud (www.1forme.fr).
  ' Licence     : CC-BY-NC-SA (Vous pouvez diffuser/partager/modifier cette macro dans les même conditions,
  '                           seulement à titre personnel et citant l'auteur/site d'origine.

    Dim objCache        As PivotCache
    Dim objFeuille      ' La collection Sheets peut contenir des objets Chart ou Worksheet
    Dim objTCD          As PivotTable
    Dim objGraphInteg   As ChartObject
    Dim objGraphFeuille As Chart
    Dim tabResultat()
    
    ReDim tabResultat(1 To ActiveWorkbook.PivotCaches.Count, 11)

    TabQueryType = Array("1-Source de données ODBC", "2-Jeux d'enregistrement DAO", "3-Non référencé", "4-Page web", _
                        "5-Requête OLE DB", "6-Fichier texte", "7-Requête de jeux d'enregistrement ADO", "8-Non référencé")
    TabSourceType = Array("1-Liste ou base de données Excel", "2-Données externes", _
                        "3-Plages de consolidation multiples", "4-Données de scénarios", _
                        "5-Même source qu'un autre rapport de tableau croisé dynamique", "6-Non référencé")
    For Each objCache In ActiveWorkbook.PivotCaches
            tabResultat(objCache.Index, 0) = objCache.Index
            tabResultat(objCache.Index, 1) = objCache.RefreshDate
            tabResultat(objCache.Index, 2) = objCache.RefreshName
            On Error Resume Next
            tabResultat(objCache.Index, 3) = TabQueryType(Application.Min(objCache.QueryType, 8) - 1)
            If Not IsError(TryGetProperty(objCache, "Sql")) Then
                tabResultat(objCache.Index, 4) = objCache.Sql
            End If
            If Not IsError(TryGetProperty(objCache, "SourceData")) Then
                tabResultat(objCache.Index, 5) = objCache.SourceData
            End If
            If Not IsError(TryGetProperty(objCache, "CommandText")) Then
                If objCache.CommandText = "Model" Then _
                    tabResultat(objCache.Index, 5) = tabResultat(objCache.Index, 5) & "Modèle de données"
            End If
            tabResultat(objCache.Index, 6) = objCache.SourceDataFile
            On Error GoTo 0
            tabResultat(objCache.Index, 7) = TabSourceType( _
                IIf(objCache.SourceType = xlPivotTable, 5, Application.Min(objCache.SourceType, 6)) - 1)
    Next
    
    For Each objFeuille In ActiveWorkbook.Sheets
        ' La propriété PivotTables de l'objet Workbook ne retourne pas tous les objets PivotTable du
        ' classeur mais uniquement ceux associés à des graphiques croisés dynamiques découplés !
        ' Il faut parcourir les PivotTables des objets Worksheet.
        If TypeName(objFeuille) = "Worksheet" Then
            ' Parcours des PivotTables de la feuille
            For Each objTCD In objFeuille.PivotTables
                tabResultat(objTCD.PivotCache.Index, 8) = tabResultat(objTCD.PivotCache.Index, 8) + 1
                tabResultat(objTCD.PivotCache.Index, 9) = tabResultat(objTCD.PivotCache.Index, 9) & _
                                                        IIf(Len(tabResultat(objTCD.PivotCache.Index, 9)) <> 0, ", ", "") & _
                                                        objTCD.Name
            Next objTCD
            ' Parcours des graphiques intégrés de la feuille
            For Each objGraphInteg In objFeuille.ChartObjects
                If Not objGraphInteg.Chart.PivotLayout Is Nothing Then
                    ' C'est un GCD
                    tabResultat(objGraphInteg.Chart.PivotLayout.PivotCache.Index, 10) = tabResultat(objGraphInteg.Chart.PivotLayout.PivotCache.Index, 10) + 1
                    tabResultat(objGraphInteg.Chart.PivotLayout.PivotCache.Index, 11) = _
                        tabResultat(objGraphInteg.Chart.PivotLayout.PivotCache.Index, 11) & _
                        IIf(Len(tabResultat(objGraphInteg.Chart.PivotLayout.PivotCache.Index, 11)) <> 0, ", ", "") & _
                        objGraphInteg.Name & "(" & IIf(TypeName(objGraphInteg.Chart.PivotLayout.PivotTable.Parent) = "Workbook", _
                        "Graph non lié à TCD", objGraphInteg.Chart.PivotLayout.PivotTable.Name) & ")"
                End If
            Next objGraphInteg
        ElseIf TypeName(objFeuille) = "Chart" Then
            ' Feuille graphique
            If Not objFeuille.PivotLayout Is Nothing Then
            tabResultat(objFeuille.PivotLayout.PivotCache.Index, 10) = tabResultat(objFeuille.PivotLayout.PivotCache.Index, 10) + 1
            tabResultat(objFeuille.PivotLayout.PivotCache.Index, 11) = _
                tabResultat(objFeuille.PivotLayout.PivotCache.Index, 11) & _
                IIf(Len(tabResultat(objFeuille.PivotLayout.PivotCache.Index, 11)) <> 0, ", ", "") & _
                objFeuille.Name & "(" & objFeuille.PivotLayout.PivotTable.Name & ")"
            End If
        End If
    Next
    
    Worksheets.Add
    TabEtiquette = Array("N° Cache", "Date Maj", "Qui a maj", "Type de requête", "Requête", "Donnée source", _
        "Fichier de données", "Type de source", "Nbre de TCD", "Noms des TCD", "Nbre de GCD", "Noms des GCD (TCD lié)")
    [A1:L1] = TabEtiquette
    Range("A2:L" & ActiveWorkbook.PivotCaches.Count + 1) = tabResultat
    Columns("A:L").AutoFit
End Sub

Function TryGetProperty(obj As Object, strNomProp As String) As Variant
    On Error GoTo GestionErreur
    TryGetProperty = CallByName(obj, strNomProp, VbGet)
    Exit Function

GestionErreur:
    TryGetProperty = CVErr(3000) ' Retourner une erreur spécifique ou une valeur par défaut
End Function

Sub RendreTCDIndependant()
  ' Objectif    : Création d'un nouveau cache pour un tableau dynamique existant
  ' Utilisation : Sélectionner une cellule du tableau croisé dynamique puis exécuter la macro.
  ' Auteur      : Arnaud (www.1forme.fr).
  ' Licence     : CC-BY-NC-SA (Vous pouvez diffuser/partager/modifier cette macro dans les même conditions,
  '                           seulement à titre personnel et citant l'auteur/site d'origine.
    Dim objTCD          As PivotTable
    Dim tabSouceData
    Dim strAdresseA1    As String
    Dim objCache        As PivotCache
    Dim strSourceData   As String
    
    Set objTCD = ActiveCell.PivotTable
    If objTCD Is Nothing Then
        MsgBox "La cellule active n'est pas une cellule de tableau croisé dynamique !", vbCritical, "Exécution impossible"
    Else
        ' Traitement de SourceData
        tabSouceData = Split(objTCD.SourceData, "!") ' Séparer la feuille et la plage
    '   Convertir la plage en notation A1
        strAdresseA1 = Application.ConvertFormula(Formula:=Replace(tabSouceData(1), "L", "R"), _
                                           fromReferenceStyle:=xlR1C1, _
                                           toReferenceStyle:=xlA1)
        ' Retourner l'adresse complète avec le nom de la feuille
        strAdresseA1 = tabSouceData(0) & "!" & strAdresseA1
        
        Set objCache = ActiveWorkbook.PivotCaches.Create( _
                            SourceType:=xlDatabase, _
                            SourceData:=ActiveSheet.Range(strAdresseA1))
        objTCD.ChangePivotCache objCache ' C'est à ce moment que le cache est vraiment généré
        objTCD.RefreshTable
        MsgBox "Action réalisée", vbInformation, "Fin d'exécution"
    End If
    Set objTCD = Nothing
    Set objCache = Nothing
End Sub

Sub ChangeTCDCache()
  ' Objectif    : Affecter un cache existant à un tableau dynamique existant
  ' Utilisation : Sélectionner une cellule du tableau croisé dynamique puis exécuter la macro.
  ' Auteur      : Arnaud (www.1forme.fr).
  ' Licence     : CC-BY-NC-SA (Vous pouvez diffuser/partager/modifier cette macro dans les même conditions,
  '                           seulement à titre personnel et citant l'auteur/site d'origine.

    Dim varReponse As Variant
    
    varReponse = InputBox("N° du cache données ou nom du tableau croisé dynamique" & _
                            " lié à utiliser :", "Changement de cache de données")
    If varReponse <> "" Then
        If Not IsNumeric(varReponse) Then
            ' Test d'existence (la collection ActiveWorkbook.PivotTables n'est pas utilisable, il
            '    faut trouver la feuille contenant le TCD
            Dim objTCD      As PivotTable
            Dim objFeuille  As Worksheet
            Dim bolTrouve   As Boolean
            
            For Each objFeuille In ActiveWorkbook.Worksheets
                For Each objTCD In objFeuille.PivotTables
                    If objTCD.Name = varReponse Then
                        bolTrouve = True
                        Exit For
                     End If
                Next objTCD
                If bolTrouve Then Exit For
            Next objFeuille
            If bolTrouve Then
                varReponse = objTCD.CacheIndex
            Else
                MsgBox "Le tableau croisé dynamique '" & varReponse & "' n'a pas été trouvé !", vbCritical, "Exécution impossible"
                Exit Sub
            End If
        End If
        ActiveCell.PivotTable.CacheIndex = CInt(varReponse)
        ActiveCell.PivotTable.RefreshTable
    Else
        MsgBox "Aucune réponse !", vbCritical, "Exécution impossible"
    End If
End Sub

Sub MajGraphIndependants()
    Dim objTcd As PivotTable
    
    ActiveWorkbook.RefreshAll
    For Each objTcd In ActiveWorkbook.PivotTables
        objTcd.PivotCache.Refresh
        objTcd.Update
    Next
End Sub