XL 2019 Masquer les flèches filtre sur TCD

[pierrelcq]

Bonjour,

Je fais une nouvelle fois appel à votre aide

Il existe pas mal de topic sur internet concernant ce sujet, mais après plusieurs essais de différentes macros, je n'arrive pas à cacher ces fameuses flèches...

Je sais qu'il existe une fonction dans les options des TCD pour masquer les flèches, mais elle ne me convient pas.

J'ai essayé les macros suivantes sans succès :

1- ActiveSheet.ListObjects("YourTableName").ShowAutoFilterDropDown = False

2- ActiveSheet.ListObjects("MyTableName").ShowAutoFilter = False

3- Sub HideArrowsList1()
'hides all arrows except list 1 column 2
Dim Lst As ListObject
Dim c As Range
Dim i As Integer
Application.ScreenUpdating = False
Set Lst = ActiveSheet.ListObjects(1)
i = 1
For Each c In Lst.HeaderRowRange
If i <> 2 Then
Lst.Range.AutoFilter Field:=i, _
VisibleDropDown:=False
Else
Lst.Range.AutoFilter Field:=i, _
VisibleDropDown:=True
End If
i = i + 1
Next
Application.ScreenUpdating = True
End Sub

Les TCD sont situés sur les dernières feuilles du classeur, et le mdp des feuille est "condeordolog"

En espérant que l'un d'entre vous est la solution !

Bien cordialement

Pierre

 

[chris]

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

 

[Hasco]

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.

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

Par celle-ci :

pvf.EnableItemSelection =Not pvf.EnableItemSelection

Cordialement

 

[chris]

RE

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

 

[pierrelcq]

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

 

[Hasco]

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

 

[pierrelcq]

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

 

[Hasco]

Bonjour,

Pas loin, pas loin

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

 

[pierrelcq]

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

 

[Hasco]

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.

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

 

[pierrelcq]

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

Bonne continuation également

 

[Hasco]

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

Bonne continuation également

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 :

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

 

[merinos-BernardEtang]

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

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

 

[pierrelcq]

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 :

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

ça marche toujours au top, merci!