XL 2019 Masquer les flèches filtre sur TCD

chris

XLDnaute Barbatruc

• 1 Mars 2021

• #2

Bonjour

En général le VBA ne modifie pas le fonctionnement d'Excel, il ne fait qu'automatiser

SI tu veux masquer les flèches il faut utiliser l'option prévue et retaper une ligne de titre au-dessus des TCD

 

Vote positif 0 Vote négatif

Hasco

XLDnaute Barbatruc

Repose en paix

• 1 Mars 2021

• #3

Bonjour,

Votre macro concernait les ListObjects (tableau structurés) et non les TCD.
Celle ci-dessous cachera les flèches de sélection du TCD de la cellule active si il y en a un.

Code:

Sub CacherFlèchesTCD()
  On Error Resume Next
  HideArrows ActiveCell.PivotTable
  On Error GoTo 0
End Sub

Private Sub HideArrows(Pvt As PivotTable)
    Dim i As Long
    Dim pvf As PivotField
    On Error GoTo FIN
    For Each pvf In Pvt.PivotFields
        pvf.EnableItemSelection = False
    Next
FIN:
    On Error GoTo 0
End Sub

La première lance la seconde uniquement si la cellule active fait partie d'un tcd en lui passant le TCD en paramètre.

Si vous voulez ultérieurement Afficher/Masquer, remplacez la ligne (bascule de l'un à l'autre):

pvf.EnableItemSelection = False

Cliquez pour agrandir...

Par celle-ci :

pvf.EnableItemSelection =Not pvf.EnableItemSelection

Cliquez pour agrandir...

Cordialement

 

Pièces jointes

• Partage Ordo-Log-Com.xlsm

  487.1 KB · Affichages: 5

Vote positif 0 Vote négatif

chris

XLDnaute Barbatruc

• 1 Mars 2021

• #4

RE

Arf j'avais oublié celui-là... Merci Roblochon

 

Vote positif 0 Vote négatif

P

pierrelcq

XLDnaute Junior

• 1 Mars 2021

• #5

Un grand merci Roblochon, j'essaye de trouver la technique pour que toutes les flèches des TCD d'une feuille se masque en même temps et ça sera top !

Merci beaucoup

 

Vote positif 0 Vote négatif

Hasco

XLDnaute Barbatruc

Repose en paix

• 1 Mars 2021

• #6

Re,

Une idée que je vous laisse transcrire en vba :
Vous avez une collection PivotTables pour chaque feuille de travail du classeur, il suffit de parcourir cette collection et d'appeler pour chacun des items de la collection ( PivotTable) la macro HideArrows avec l'item en paramètre.

Une piste : For each ... in .....

Cordialement

 

Dernière édition: 1 Mars 2021

Vote positif 0 Vote négatif

P

pierrelcq

XLDnaute Junior

• 1 Mars 2021

• #7

Roblochon,

Merci pour tes indications.

J'ai essayé quelque chose grâce à vos indications mais cela ne fonctionne pas

Je dois surement être à côté de la plaque ..

Sub CacherFlèchesTCD()
On Error Resume Next
Dim Sheet As Worksheet, Pivot As PivotTable
For Each Sheet In ThisWorkbook.Worksheets
For Each Pivot In Sheet.PivotTables
Pivot.HideArrows
Next
Next
On Error GoTo 0
End Sub



Private Sub HideArrows(pvt As PivotTable)
Dim i As Long
Dim pvf As PivotField
On Error GoTo FIN
For Each pvf In pvt.PivotFields
pvf.EnableItemSelection = Not pvf.EnableItemSelection
Next
FIN:
On Error GoTo 0
End Sub

Merci beaucoup

 

Vote positif 0 Vote négatif

Hasco

XLDnaute Barbatruc

Repose en paix

• 1 Mars 2021

• #8

Bonjour,

Pas loin, pas loin

VB:

Sub CacherFlèchesTCD()
On Error Resume Next
Dim Ws As Worksheet, Pvt As PivotTable
   For Each Ws In ThisWorkbook.Worksheets
      For Each Pvt In Ws.PivotTables
          HideArrows Pvt
       Next
   Next
On Error GoTo 0
End Sub

1 - Surtout évitez de donner des mots clefs vba comme nom à vos variables, (Sheet, Pivot etc..) si vous ne voulez pas avoir d'ennui
2 - HideArrows est une procédure (macro) avec paramètre.
Pour appeler une procédure avec paramètre : NomDeLaProcédure ValeurPourLeParamètre
HideArrows Pvt et non Pvt.HideArrows


Cordialement

 

Dernière édition: 1 Mars 2021

Vote positif 0 Vote négatif

P

pierrelcq

XLDnaute Junior

• 1 Mars 2021

• #9

Ahh l'erreur de débutant ...

Du coup le résultat final est celui ci-dessous, j'ai voulu remplacer la ligne comme vous m'avez indiqué car je veux que la macro puisse masquer/démasquer.

pvf.EnableItemSelection =Not pvf.EnableItemSelection

Mais il semblerait que cela coince qlq part, vous voyez quelque chose qui pourrait ne pas faire marcher la macro?


Sub CacherFlèchesTCD()
On Error Resume Next
Dim Ws As Worksheet, Pvt As PivotTable
For Each Ws In ThisWorkbook.Worksheets
For Each Pvt In Sheet.PivotTables
HideArrows Pvt
Next
Next
On Error GoTo 0
End Sub



Private Sub HideArrows(Pvt As PivotTable)
Dim i As Long
Dim pvf As PivotField
On Error GoTo FIN
For Each pvf In Pvt.PivotFields
pvf.EnableItemSelection = Not pvf.EnableItemSelection
Next
FIN:
On Error GoTo 0
End Sub

Merci d'avance!

Pierre

 

Vote positif 0 Vote négatif

Hasco

XLDnaute Barbatruc

Repose en paix

• 1 Mars 2021

• #10

Re,

Dans ces cas là, pour situer le problème, on commence par "commenter" les ligne On Error Goto ou Resume Next en leur mettant une apostrophe en début de ligne.

Dans les lignes que je vous ai précédemment passées un Sheets avait été oublié, remplacé par Ws ci-dessous.
Autre problème que cachait les on error resume .... : vous avez des feuilles protégées. Impossible de modifier les TCD d'une feuille protégée. Donc il faut déprotéger avant l'appel à la macro qui cache ou non les flèches.

Comme nous n'avons pas les mots de passe de vos feuilles je n'ai pas pu tester sur toutes les feuilles de votre classeur. Sur celles qui sont non protégées, les lignes ci-dessous fonctionnent:



Quand tout roulera, décommenter les lignes On error .... en enlevant l'apostrophe mis précédemment.

VB:

Sub CacherFlèchesTCD()
    On Error Resume Next
    Dim Ws As Worksheet, Pvt As PivotTable
    For Each Ws In ThisWorkbook.Worksheets
        Ws.Unprotect "MotDePasse"    'Remplacer par votre mot de passe
        For Each Pvt In Ws.PivotTables
            HideArrows Pvt
        Next
        Ws.Protect    'idem
    Next
    On Error GoTo 0
End Sub

Private Sub HideArrows(Pvt As PivotTable)
    Dim i As Long
    Dim pvf As PivotField
    On Error GoTo FIN
    For Each pvf In Pvt.PivotFields
        pvf.EnableItemSelection = Not pvf.EnableItemSelection
    Next
FIN:
    On Error GoTo 0
End Sub

Bonne continuation

 

Vote positif 0 Vote négatif

Solution

P

pierrelcq

XLDnaute Junior

• 1 Mars 2021

• #11

C'est incroyable merci beaucoup pour le temps passé!!

Bonne continuation également

 

Vote positif 0 Vote négatif

Hasco

XLDnaute Barbatruc

Repose en paix

• 1 Mars 2021

• #12

pierrelcq à dit:

C'est incroyable merci beaucoup pour le temps passé!!

Bonne continuation également

Cliquez pour agrandir...

Re j'ai modifié un peu mon précédent poste pour déplacer la déprotection / protection au niveau de la boucle de la feuille. Ce qui est plus logique. Vérifiez que vous avez cette version :

VB:

Sub CacherFlèchesTCD()
    On Error Resume Next
    Dim Ws As Worksheet, Pvt As PivotTable
    For Each Ws In ThisWorkbook.Worksheets
        Ws.Unprotect "MotDePasse"    'Remplacer par votre mot de passe
        For Each Pvt In Ws.PivotTables
            HideArrows Pvt
        Next
        Ws.Protect    'idem
    Next
    On Error GoTo 0
End Sub

 

Vote positif 0 Vote négatif

merinos-BernardEtang

XLDnaute Accro

• 1 Mars 2021

• #13

trouvé sur https://www.contextures.com/xlPivot12.html:

VB:

Sub DisableSelection()
'pivot table tutorial by contextures.com
Dim pt As PivotTable
Dim pf As PivotField
On Error Resume Next
Set pt = ActiveSheet.PivotTables(1)
  For Each pf In pt.PivotFields
      pf.EnableItemSelection = False
  Next pf
End Sub

 

Vote positif 0 Vote négatif

P

pierrelcq

XLDnaute Junior

• 1 Mars 2021

• #14

Roblochon à dit:

Re j'ai modifié un peu mon précédent poste pour déplacer la déprotection / protection au niveau de la boucle de la feuille. Ce qui est plus logique. Vérifiez que vous avez cette version :

VB:

Sub CacherFlèchesTCD()
    On Error Resume Next
    Dim Ws As Worksheet, Pvt As PivotTable
    For Each Ws In ThisWorkbook.Worksheets
        Ws.Unprotect "MotDePasse"    'Remplacer par votre mot de passe
        For Each Pvt In Ws.PivotTables
            HideArrows Pvt
        Next
        Ws.Protect    'idem
    Next
    On Error GoTo 0
End Sub

Cliquez pour agrandir...

ça marche toujours au top, merci!

 

Vote positif 0 Vote négatif