Macro pour filtrer les TCD

Bonjour,

J'ai des forme qui représente des secteur.

les forme ont toutes la même couleur, sauf sue celle sur laquelle je clique dessus.

Je cherche à faire un test pour filtrer les TCD.

Avant tout, il faudrait que lorsque je clique sur une fome, le nom de la forme apparaissent dans une cellule.

Ensuite les TCD se filtres selon cette valeur de cellule (qui représente les secteur).

Voici le code qui n'est pas finalisé pour cela.

Option Explicit

Sub forme_Interactive()

'Déclaration des variables
Dim Nomcadre As String
Dim Shape
Dim Secteur As String

'Propriété caller : permettre d'afficher la manière dont visual basic est appelé
   Nomcadre = Application.Caller

'Mise en couleur par défaut la carte'

For Each Shape In ActiveSheet.Shapes 'Pour chacune des formes de la feuille active
   Shape.Fill.ForeColor.RGB = RGB(176, 206, 164) 'on applique une couleur à la forme
Next Shape

'on affecte une couleur lorsque la forme est sélectionnée
ActiveSheet.Shapes(Nomcadre).Fill.ForeColor.RGB = RGB(235, 241, 222)

'on affecte une couleur sur la région correspondante au tableau

'******************************************************************************* (le code marche jusqu'ici)
If Secteur = Nomcadre Then 'si le nom de la région est égal au nom de la forme

 '
ActiveSheet.pivoTables("PivotTable1").PivotFields("Secteur").ClearAllFilters
ActiveSheet.pivoTables("PivotTable1").PivotFields("Secteur").CurrentPage = ActiveSheet.Range("A2").Value
ActiveSheet.pivoTables("PivotTable2").PivotFields("Secteur").ClearAllFilters
ActiveSheet.pivoTables("PivotTable2").PivotFields("Secteur").CurrentPage = ActiveSheet.Range("A2").Value
ActiveSheet.pivoTables("PivotTable5").PivotFields("Secteur").ClearAllFilters
ActiveSheet.pivoTables("PivotTable5").PivotFields("Secteur").CurrentPage = ActiveSheet.Range("A2").Value

End If

End Sub

Et voici le fichier joint

Si vous avez la solution, car je n'arrive déjà meme pas à faire en sorte que le nom de la forme sur laquelle je clique apparaisse dans une cellule.

Merci par avance et bonnes fête des fin d'années à Tous, et particulièrement à Raja, Banzai64, Yvouine,...

Bonsoir,

Ci-joint une version à tester, prenant en compte le filtre sur les 3 TCD.

Bonne soirée

Bouben

Bonjour,

Je viens de tester, mais j'ai un message d'erreur,

Erreur impossible de définir la propriété de Curentpage de la classe PivotField

Ensuite il me mets en jaune cette ligne du code

oShCalcul.PivotTables(1).PivotFields("Secteur").CurrentPage = Nomcadre

Bonsoir,

Ci-joint une nouvelle version à tester ...

Bouben

Merci beaucoup

Cela marche parfaitement

bonne soirée et bonne fin d'année 2015

bouben a écrit :

Bonsoir,

Ci-joint une nouvelle version à tester ...

Bouben

Bonsoir,

Je m'excuse, car il y a encore un petit souci.

En fait, j'ai rajoué un segment mois, et du coup le code me met un message d'erreur sur Shape,

Je met le fichier joit

Le segment mois est une fenêtre me permettant de trier les données des TCD par mois.

Bonsoir,

On boucle sur toutes les Shapes. Et l'objet "Segment" ajouté n'a pas les mêmes propriétés.

En testant sur le type de Shape, ça a l'air de passer.

If Shape.Type = msoFormControl Then
        Shape.Fill.ForeColor.RGB = RGB(176, 206, 164) 'on applique une couleur à la forme
End If

A tester

Bouben

Bonsoir,

J'ai testé, mais je crois que je n'ai pas mis la ligne de code ou il fallait.

Je mets le fichier joint

En fait, maintenant quand je clique sur un forme, puis sur une autre, il efface pas la précédente sélection de forme.

Ainsi, toutes mes formes deviennent de la couleur de sélection (vert très pale.

  Nomcadre = Application.Caller

Sans doute que je n'ai pas mis ou il faut la ligne de code

Sub forme_Interactive()

    'Déclaration des variables
    Dim Nomcadre As String
    Dim Shape
    Dim Secteur As String

    Dim oShTAB As Worksheet 'onglet "TAB"
    Dim oShCalcul As Worksheet 'onglet "Calcul"

    Dim oTCD As PivotTable

    Set oShTAB = Worksheets("TAB")
    Set oShCalcul = Worksheets("Calcul")

    'Propriété caller : permettre d'afficher la manière dont visual basic est appelé
    Nomcadre = Application.Caller

    'Mise en couleur par défaut la carte'

    For Each Shape In oShTAB.Shapes 'Pour chacune des formes de la feuille active

      If Shape.Type = msoFormControl Then
        Shape.Fill.ForeColor.RGB = RGB(176, 206, 164) 'on applique une couleur à la forme
      End If

    Next Shape

    'on affecte une couleur lorsque la forme est sélectionnée
    oShTAB.Shapes(Nomcadre).Fill.ForeColor.RGB = RGB(235, 241, 222)

    'on affecte une couleur sur la région correspondante au tableau

    oShCalcul.Range("A2").Value = Nomcadre

    '******************************************************************************* (le code marche jusqu'ici)
    'If Secteur = Nomcadre Then 'si le nom de la région est égal au nom de la forme

    'V0.2
'    oShCalcul.PivotTables(1).PivotFields("Secteur").ClearAllFilters
'    oShCalcul.PivotTables(1).PivotFields("Secteur").CurrentPage = Nomcadre
'    oShCalcul.PivotTables(2).PivotFields("Secteur").ClearAllFilters
'    oShCalcul.PivotTables(2).PivotFields("Secteur").CurrentPage = Nomcadre
'    oShCalcul.PivotTables(3).PivotFields("Secteur").ClearAllFilters
'    oShCalcul.PivotTables(3).PivotFields("Secteur").CurrentPage = Nomcadre
    For Each oTCD In oShCalcul.PivotTables
        On Error Resume Next
        oTCD.PivotFields("Secteur").ClearAllFilters
        oTCD.PivotFields("Secteur").CurrentPage = Nomcadre
        On Error GoTo 0
    Next oTCD
    'V0.2-fin

    'End If

    Set oShTAB = Nothing
    Set oShCalcul = Nothing

End Sub

Merci

La ligne est au bon endroit. La cause du problème est qu'il y a des groupes de contrôles.

Ligne à modifier :

 If Shape.Type = msoFormControl Or Shape.Type = msoGroup Then

A tester

Tout est OK,

C'est vrai que le fait d'avoir intégrer le segment mois, cela a provoqué un conflit avec l'autre groupe de forme.

Merci beaucoup, ce n'était pas évident.

Passez une bonne fin d'année et a bientôt sur le forum.

Merci