Synchro filtres de plusieurs tcd en même temps avec VBA

Le 19/09/2014 à 14:27

Bonjour à toutes et tous,

Je réalise actuellement sur Excel 2007 une grosse étude où je synchronise plusieurs TCD (leurs filtres en fait) en utilisant une macro VBA dont j'ai trouvé le code sur le web.

J'ai une quarantaine de TCD qui dépendent tous de la même source de données.

Chacun de ces TCD a trois filtres identiques sur tous les TCD, à savoir le filtre "UM (libellé court)", le filtre "Code heure (libellé)" et le filtre "Période".

Le code VBA marche tout à fait avec le filtre "UM (libellé court)" et avec le filtre "Code heure (libellé)" mais, avec le filtre "Période", il bug.

Lorsque je l'exécute, Excel affiche le message "erreur d'exécution 13 : incompatibilité de type".

Ci-dessous, le code pour le filtre "UM (libellé court)" que j'adapte pour le filtre "Code heure (libellé)" et pour le filtre "Période" en changeant PivotFields :

Sub OneForAll_UM()

Dim PT_MAIN As PivotTable

Dim PT As PivotTable

Dim PFN(), PF As Integer, P, I

ActiveWorkbook.RefreshAll

'table de référence

Set PT_MAIN = ActiveSheet.PivotTables("TCD1")

I = 1

'récuperer les noms de filtres inactifs

For PF = 1 To PT_MAIN.PivotFields("UM (libellé court)").PivotItems.Count

If Not PT_MAIN.PivotFields("UM (libellé court)").PivotItems(PF).Visible Then

'redimensionner PFN en fonction du nombre de filtres inactif sur le champ UM (libellé court)

ReDim Preserve PFN(1 To I) 'preserve pour ne pas perdre les données précédemment inscrites

'l'ajouter

PFN(I) = PT_MAIN.PivotFields("UM (libellé court)").PivotItems(PF).Name

I = I + 1 'on incrémente en prévision du prochain filtres inactif à ajouter

End If

Next PF

'nb de filtre inactifs

On Error GoTo ShowAll

I = UBound(PFN)

On Error GoTo 0

'les appliquer sur les autres tables pivot

For Each PT In ActiveSheet.PivotTables

'sauf si c'est la table pivot de référence

If Not PT.Name = PT_MAIN.Name Then

With PT

'activation de la sélection multiple

PT.PivotFields("UM (libellé court)").EnableMultiplePageItems = True

'on affiche tout les filtres disponibles

For Each P In PT.PivotFields("UM (libellé court)").PivotItems

P.Visible = True

Next P

'on désactive les filtres devant être inactif

If Not I = 0 Then

For PF = 1 To I

PT.PivotFields("UM (libellé court)").PivotItems(PFN(PF)).Visible = False

Next PF

End If

End With

End If

Next PT

Exit Sub

ShowAll:

I = 0

Resume Next

End Sub

Si je modifie le début du code VBA pour le filtre "Période ainsi :

Dim PT_MAIN As PivotTable

Dim PT As PivotTable

Dim PFN() As Integer, P, I

Dim PF As Date

alors Excel affiche le message "erreur d'exécution 1004 : impossible de lire la propriété PivotItems de la classe PivotField".

Si quelqun peut me dire quelle propriété utiliser pour PF et me donner le code, ce serait sympa.

Merci d'avance.

Erwan

Le 21/09/2014 à 06:35

Bonjour,

Sans fichier joint, il est difficile d'apporter une réponse précise.

Mais essaie ce code et adapte le.

A te relire, peut-être

Cdlt.

Option Explicit
'Option Private Module
Public Sub test()
Dim PT_main As PivotTable, PT As PivotTable
Dim strPF As String
Dim pi As PivotItem
Dim I As Integer
Dim x()

    Application.ScreenUpdating = False

    Set PT_main = ActiveSheet.PivotTables("TCD1")
    PT_main.RefreshTable

    strPF = "UM (libellé court)"
    I = 1

    With PT_main.PivotFields(strPF)
        For Each pi In .PivotItems
            If Not pi.Visible Then
                ReDim Preserve x(1 To I)
                x(I) = pi.Name
                I = I + 1
            End If
        Next pi
    End With

    If I = 1 Then Exit Sub

    For Each PT In ActiveSheet.PivotTables
        If PT.Name <> PT_main.Name Then
            With PT.PivotFields(strPF)
                .ClearManualFilter
                For I = LBound(x) To UBound(x)
                    .PivotItems(x(I)).Visible = False
                Next I
            End With
        End If
    Next PT

    Set PT_main = Nothing
    Erase x

End Sub
Le 26/09/2014 à 09:39

Bonjour Jean-Eric et merci,

Désolé pour le retard de réponse mais j'avais pas mal d'études cette semaine à réaliser assez urgemment.

Merci pour votre code VBA trop MEGA GENIALO BIEN !

En effet, le mien mettait environ 4 mn pour actualiser tous les TCD en fonction des données filtrées sur le TCD1.

Le votre met 10 sec à peu près pour la même tâche.

Trop fort !

Encore merci.

Avec le PivotFields "UM (libellé court)" et le PivotFields "Code heure (libellé)", ça marche comme sur des roulettes.

Autrement dit, si je laisse

strPF = "UM (libellé court)"

ou que je mets

strPF = "Code heure (libellé)"

, ça roule.

En revanche, si le PivotFields est "Période", alors excel affiche Erreur d'exécution 13 : incompatibilité de type

Si je clique sur "débogage", VBA surligne en jaune

If Not pi.Visible Then

Si je change

Dim strPF As String

en

Dim strPF As Date

, excel affiche le même message et, en débogage, surligne

strPF = "Période"

Pouvez-vousSVP me dire comment modifier le code avec le PivotFields "Période" ?

Merci à vous.

Cordialement.

Erwan

Le 26/09/2014 à 09:54

Bonjour,

Peux-tu joindre un fichier ou décrire précisément le champ 'Période' et son contenu?

Cdlt.

Le 26/09/2014 à 10:57

En fait, avec le code VBA que vous m'avez fourni, l'actualisation des filtres de tous mes TCD en fonction des filtres sélectionnés dans TCD1 marche impec dans mon étude mais, que pour le filtres (ou PivotFields) "UM (libellé court)" et "Code heure (libellé)", pas avec le filtre "Période".

Pour info, voici votre code adapté pour "UM (libellé court)" :

Option Explicit
'Option Private Module

Public Sub Oneforall_UM_LIB_COURT()

Dim PT_main As PivotTable, PT As PivotTable
Dim strPF As String
Dim pi As PivotItem
Dim I As Integer
Dim x()

    Application.ScreenUpdating = False

    Set PT_main = ActiveSheet.PivotTables("TCD1")
    PT_main.RefreshTable

    strPF = "UM (libellé court)"
    I = 1

    With PT_main.PivotFields(strPF)
        For Each pi In .PivotItems
            If Not pi.Visible Then
                ReDim Preserve x(1 To I)
                x(I) = pi.Name
                I = I + 1
            End If
        Next pi
    End With

    If I = 1 Then Exit Sub

    For Each PT In ActiveSheet.PivotTables
        If PT.Name <> PT_main.Name Then
            With PT.PivotFields(strPF)
                .ClearManualFilter
                For I = LBound(x) To UBound(x)
                    .PivotItems(x(I)).Visible = False
                Next I
            End With
        End If
    Next PT

    Set PT_main = Nothing
    Erase x

End Sub

Voici votre code adapté pour "Code heure (libellé)" :

Option Explicit
'Option Private Module

Public Sub Oneforall_CODE_HEURE()

Dim PT_main As PivotTable, PT As PivotTable
Dim strPF As String
Dim pi As PivotItem
Dim I As Integer
Dim x()

    Application.ScreenUpdating = False

    Set PT_main = ActiveSheet.PivotTables("TCD1")
    PT_main.RefreshTable

    strPF = "Code heure (libellé)"
    I = 1

    With PT_main.PivotFields(strPF)
        For Each pi In .PivotItems
            If Not pi.Visible Then
                ReDim Preserve x(1 To I)
                x(I) = pi.Name
                I = I + 1
            End If
        Next pi
    End With

    If I = 1 Then Exit Sub

    For Each PT In ActiveSheet.PivotTables
        If PT.Name <> PT_main.Name Then
            With PT.PivotFields(strPF)
                .ClearManualFilter
                For I = LBound(x) To UBound(x)
                    .PivotItems(x(I)).Visible = False
                Next I
            End With
        End If
    Next PT

    Set PT_main = Nothing
    Erase x

End Sub

Voici votre code adapté pour "Période" (mais qui ne marche pas comme expliqué avant) :

Option Explicit
'Option Private Module

Public Sub Oneforall_PERIODE()

Dim PT_main As PivotTable, PT As PivotTable
Dim strPF As Date
Dim pi As PivotItem
Dim I As Integer
Dim x()

    Application.ScreenUpdating = False

    Set PT_main = ActiveSheet.PivotTables("TCD1")
    PT_main.RefreshTable

    strPF = "Période"
    I = 1

    With PT_main.PivotFields(strPF)
        For Each pi In .PivotItems
            If Not pi.Visible Then
                ReDim Preserve x(1 To I)
                x(I) = pi.Name
                I = I + 1
            End If
        Next pi
    End With

    If I = 1 Then Exit Sub

    For Each PT In ActiveSheet.PivotTables
        If PT.Name <> PT_main.Name Then
            With PT.PivotFields(strPF)
                .ClearManualFilter
                For I = LBound(x) To UBound(x)
                    .PivotItems(x(I)).Visible = False
                Next I
            End With
        End If
    Next PT

    Set PT_main = Nothing
    Erase x

End Sub

Je joint en pièce jointe une image de quelques TCD pour constater que les formats des 3 filtres sont différents : 2 au format texte("UM (libellé court)" et "Code heure (libellé)"), 1 au format date courte ("Période").

Dites-moi si vous avez besoin de plus d'infos.

Je pense que le code VBA ne fonctionne pas avec le filtre "Période" du fait de son format.

Erwan

captureabsenteisme
Le 26/09/2014 à 12:20

Re,

En regardant ton image, les champs concernés sont dans le filtre du rapport.

Les choix multiples sont-ils autorisés dans ces champs?

Cdlt.

Le 26/09/2014 à 13:59

Oui, chaque TCD à les trois mêmes filtres "UM (libellé court)", "Code heure (libellé)" et Période".

Chacun des ces filtres est bien à choix multiples : le premier propose une dizaine de choix possibles à cocher, le second, une quinzaine à cocher, le troisième va du 01/01/2013 au 01/12/2013 au choix à cocher.

Erwan

Le 26/09/2014 à 14:41

Re,

Je reprends ma question.

As-tu l'utilité de travailler avec des sélections multiples?

Si tu n'en as pas besoin, ton code initial et, par conséquence, mon code n'est pas adapté.

Joint un fichier exemple anonymisé avec 2 TCDs que je regarde de plus près le souci.

Cdlt.

Le 09/10/2014 à 09:53

Bonjour Jean-Eric,

Désolé pour le retard de réponse.

Ma hiérarchie préfère que le fichier, même transformé, n'arrive pas sur le web.

Désolé.

En fait, le problème que je rencontrais était que votre code marchait IMPEC sauf avec le filtre "Période".

Aussi, j'ai bidouillé pour transformer "Période" (auparavant en format date) en format texte.

Et maintenant, votre code marche !

Encore merci bÔcoup !

Erwan

Le 09/10/2014 à 10:27

Bonjour,

N'oublie pas de clore le sujet.

Cdlt.

Le 14/10/2014 à 13:59

Bonjour Jean-Eric,

Comment fait-on pour clore un sujet ?

Bye.

Erwan

Le 14/10/2014 à 15:53

Bonjour,

Le 15/10/2014 à 10:56

ok c'est fait

merci

Le 15/10/2014 à 11:29

Bonjour,

resolu 4
Le 15/10/2014 à 13:51

merci

Rechercher des sujets similaires à "synchro filtres tcd meme temps vba"