XL 2019 Masquer les flèches filtre sur TCD

pierrelcq

XLDnaute Junior
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
 

Pièces jointes

  • Partage Ordo-Log-Com.xlsm
    474.8 KB · Affichages: 21
Solution
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...

chris

XLDnaute Barbatruc
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

XLDnaute Barbatruc
Repose en paix
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
Par celle-ci :
pvf.EnableItemSelection =Not pvf.EnableItemSelection

Cordialement
 

Pièces jointes

  • Partage Ordo-Log-Com.xlsm
    487.1 KB · Affichages: 5

Hasco

XLDnaute Barbatruc
Repose en paix
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:

pierrelcq

XLDnaute Junior
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

XLDnaute Barbatruc
Repose en paix
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:

pierrelcq

XLDnaute Junior
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

XLDnaute Barbatruc
Repose en paix
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
 

Hasco

XLDnaute Barbatruc
Repose en paix
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 :
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
 

pierrelcq

XLDnaute Junior
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
ça marche toujours au top, merci!
 

Discussions similaires

Réponses
2
Affichages
402

Statistiques des forums

Discussions
311 725
Messages
2 081 943
Membres
101 849
dernier inscrit
florentMIG