[VBA]Filtre TCD

[bcharef]

Bonjour à toutes et à tous.

L'objectif recherché est de faire une sélection de filtrage en fonction de cellules externes d'un Tableau Croisé Dynamique par un code VBA.

Un fichier exemple ci-joint porte la difficulté recherchée ainsi que son objectif.

Il est à signaler, que je suis un ignare en VBA.

A l'avance Merci.

BCharef

 

[bcharef]

Re : [VBA]Filtre TCD

Bonsoir à toutes et à tous,
Bonsoir papou, pierrot & JCGL,
Salut kjin,

C'est génial.

Je ne sais pas comment remercier notre ami kjin pour l'effort consentie, ainsi qu'au temps précieux accordé pour la résolution du problème.

Je vais faire des efforts pour l'adapter aveuglement sur le fichier de travail d'une part et de bien comprendre les codes d'autre part.

Comme, J'en profite de l'occasion de remercier notre ami JCGL au soutien fraternels à l'initiative de trouver une solution, notre ami papou de son strict suivi au présent sujet et enfin de n'être pas fâché par nôtre ami pierrot .

Salutations distinguées.

BCharef

 

[kjin]

Re : [VBA]Filtre TCD

Bonsoir,
Tu auras peut-être remarqué (ou pas) qu'il manque les parenthèses sur cette ligne...

    If UCase(Target) <> "(TOUS)" And Application.CountIf([base].Columns(2), [G3]) = 0 Then GoTo Erreur

...à corriger donc
En fait, pour réinitialiser les champs de page, il faut indiquer (tous) en G1 et/ou en G3
Je regarderai pour faire plus simple
A+
kjin

 

[Pierrot93]

Re : [VBA]Filtre TCD

Bonjour à tous,

et enfin de n'être pas fâché par nôtre ami pierrot .

aucun souci bcharef, pour preuve petit essai ci-dessous, fait sous 2003 à utiliser dans le module de la feuiile où se trouve le tcd.. click droit sur l'onglet => visualiser le code => et tu colles...

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim p As PivotItem, s As Long
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    s = .Calculation
    .Calculation = xlCalculationManual
End With
If Not Intersect(Target, Range("G1")) Is Nothing Then
    With Me.PivotTables(1).PivotFields("NumCpt")
        If Target.Value = "Tous" Then
            .CurrentPage = "(Tous)"
        Else
            For Each p In .PivotItems
                If p.Value = Target.Value Then .CurrentPage = Target.Value
            Next p
        End If
    End With
End If
If Not Intersect(Target, Range("G3")) Is Nothing Then
    With Me.PivotTables(1).PivotFields("NumTier")
        If IsEmpty(Target.Value) Then
            .CurrentPage = "(Vide)"
            ElseIf Target.Value = "Tous" Then .CurrentPage = "(Tous)"
        Else
            For Each p In .PivotItems
                If p.Value = Target.Value Then .CurrentPage = Target.Value
            Next p
        End If
    End With
End If
If Not Intersect(Target, Range("G5,I5")) Is Nothing Then
    For Each p In Me.PivotTables(1).PivotFields("Periode").PivotItems
        p.Visible = True
    Next p
    If Target.Address = "$G$5" Then
        For Each p In Me.PivotTables(1).PivotFields("Periode").PivotItems
            If CDbl(p.Value) < Target Then p.Visible = False
        Next p
    Else
        For Each p In Me.PivotTables(1).PivotFields("Periode").PivotItems
            If p.Value > Target Then p.Visible = False
        Next p
    End If
End If
With Application
    .Calculation = s
    .EnableEvents = True
    .ScreenUpdating = True
End With
End Sub

bon dimanche à tous
@+

 

[bcharef]

Re : [VBA]Filtre TCD

Bonjour à toutes et à tous,
Bonjour papou, pierrot & JCGL & kjin.

Grand Merci à notre ami pierrot pour le geste loyale, qui fait d’une preuve flegmatique.

Il est temps de consacrer un bon moment pour la conception des codes d'une maniéré rationnelle, et une fois, que je rencontrerais des difficultés de compréhension, je n'oserais pas à vous contacter, si vous ne voyez aucun inconvénients.

Merci encore une fois mes amis.

Salutations distinguées.

BCharef

 

[bcharef]

Re : [VBA]Filtre TCD

Bonjour à toutes et à tous

Erreur de doublon du message .

Bcharef