Microsoft 365 Protection d'une feuille sauf filtre de champ TCD

Xylon92

XLDnaute Nouveau
Bonjour à tous,

Je souhaiterais avoir une feuille dans laquelle ce trouve un TCD.
Dans cette feuille, je veux que les utilisateurs du classeur puissent changer le filtre de champ du TCD (cellule B1), mais qu'ils ne puissent pas toucher au reste du TCD (filtrer les colonnes, ou altérer la structure du TCD).

J'ai testé deux solutions qui ne fonctionnent pas :
  • Déverrouiller la cellule B1 avant de protéger la feuille
  • Autoriser la modification de la plage B1 avant de protéger la feuille
Est-ce que l'un de vous aurait une solution pour moi ?
Merci par avance ! :)
 

Pièces jointes

  • Exemple.xlsx
    15.6 KB · Affichages: 12
Solution
RE

Cela risque de mouliner si chaque champ a beaucoup de valeurs
Noms correspondant à Champ1 et Champ 2 à adapter
VB:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'Empécher tout autre modification que le filtre de champ Nom
    If Me.ProtectContents = False Then Exit Sub
    Me.Protect Password:="toto", userinterfaceonly:=True, DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowUsingPivotTables:=True
    
    Dim Tchamp1, Tchamp2, Champ1 As String, Champ2 As String
    
    Champ1 = "Nom"
    Champ2 = "Commercial"
    
    Dim x As Long, y As Long, i As Long, Voir As Boolean
    Dim pt As PivotItem

    ReDim Tchamp1(Target.PivotFields(Champ1).PivotItems.Count)
    x = 0
    For Each pt In...

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Xylon,
Je n'ai peut être pas bien compris.

Mai si vous protéger la feuille TCD en cochant la case "Utiliser des rapports TCD", vous pouvez jouer sur le filtre en B1 le TCD se met à jour bien que toute cellule du TCD restent protégées.

1.jpg
 

Xylon92

XLDnaute Nouveau
Bonjour Xylon,
Je n'ai peut être pas bien compris.

Mai si vous protéger la feuille TCD en cochant la case "Utiliser des rapports TCD", vous pouvez jouer sur le filtre en B1 le TCD se met à jour bien que toute cellule du TCD restent protégées.

Regarde la pièce jointe 1071953
Bonjour Sylvanu,

Je vais essayer de m'expliquer un peu mieux.
Dans l'idéal j'aimerais que les utilisateurs du doc ne puissent changer que le filtre en B1, mais ne puissent pas changer la structure du TCD (les autres items en ligne, colonne et valeur du TCD), ou utiliser les filtres des colonnes "date arrivée" et "date départ".

J'espère être plus clair, mais si jamais ce n'est pas le cas n'hésitez pas à me le dire.

Encore merci pour votre aide !
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Dans la PJ ci dessous j'applique la protection du post #2;

Il me semble que :
1- L'utilisateur peut modifier le nom à filtrer en B1 et que le TCd se met à jour,
2-il lui est impossible de changer la structure du TCD puisque celui ci ne lui est pas accessible.
Par contre il peut effectivement filtrer la date de départ.

A priori on ne peut pas déprotéger juste une partie du TCD, c'est tout ou rien.

Peut être une astuce tirée par les cheveux :
1-En ligne 2 vous copiez les intitulés de ligne 3, avec fond bleu
2- Vous masquez la ligne 3
3- Vous protéger la feuille avec exception pour le TCD.

( J'ai essayé par macro avec un Worksheet_Change et des Protect Unprotect mais sans succés )
 

Pièces jointes

  • Exemple (24).xlsx
    14.5 KB · Affichages: 5

chris

XLDnaute Barbatruc
Bonjour

Options du TCD, Affichage, décocher Afficher lé légende des champs et les listes déroulantes de filtrage.

B1 peut lui toujours être filtré mais met plutôt un segment plus convivial...
Edit : dans ce cas ajouter la coche Modifier les objets lors de la protection
 

Xylon92

XLDnaute Nouveau
Encore merci à tous les deux, ces solutions me paraissent très bien !

J'aurais juste besoin d'une petite clarification :

@sylvanu, lorsque vous dites " 2-il lui est impossible de changer la structure du TCD puisque celui ci ne lui est pas accessible.", je ne suis pas certain de bien comprendre.
En effet lorsque je clique sur une cellule du TCD, j'ai le panneau de liste des champs qui s'affiche et je suis en capacité de changer les champs que je mets en ligne et colonne.

Est-ce une fausse manipulation de ma part ?
 

chris

XLDnaute Barbatruc
RE

Aie !
Reste VBA
A priori ceci fonctionne
A coller dans le module de la feuille
(prévu si un seul TCD dans l'onglet sinon à adapter)
VB:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'Empécher tout autre modification que le filtre de champ Nom
    If Me.ProtectContents = False Then Exit Sub
    Me.Protect Password:="toto", userinterfaceonly:=True, DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowUsingPivotTables:=True
    
    Dim Tnoms
    Dim x As Long, i As Long, Voir As Boolean

    ReDim Tnoms(Target.PivotFields("Nom").PivotItems.Count)
    x = 0
    For Each pt In Target.PivotFields("Nom").PivotItems
        If pt.Visible = True Then Tnoms(x) = pt.Caption: x = x + 1
    Next pt

    If x < 1 Then Application.Undo: GoTo Fin

    ReDim Preserve Tnoms(x - 1)
    On Error GoTo Fin
    Application.EnableEvents = False
    Application.Undo
    Target.PivotFields("Nom").ClearAllFilters
    For Each pt In Target.PivotFields("Nom").PivotItems
        For i = 0 To x - 1
            If pt.Name = Tnoms(i) Then Voir = True: Exit For
        Next i
        If Voir = False Then pt.Visible = False
        Voir = False
     Next pt
Fin:
    Application.EnableEvents = True

End Sub
 

Xylon92

XLDnaute Nouveau
RE

Aie !
Reste VBA
A priori ceci fonctionne
A coller dans le module de la feuille
(prévu si un seul TCD dans l'onglet sinon à adapter)
VB:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'Empécher tout autre modification que le filtre de champ Nom
    If Me.ProtectContents = False Then Exit Sub
    Me.Protect Password:="toto", userinterfaceonly:=True, DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowUsingPivotTables:=True
   
    Dim Tnoms
    Dim x As Long, i As Long, Voir As Boolean

    ReDim Tnoms(Target.PivotFields("Nom").PivotItems.Count)
    x = 0
    For Each pt In Target.PivotFields("Nom").PivotItems
        If pt.Visible = True Then Tnoms(x) = pt.Caption: x = x + 1
    Next pt

    If x < 1 Then Application.Undo: GoTo Fin

    ReDim Preserve Tnoms(x - 1)
    On Error GoTo Fin
    Application.EnableEvents = False
    Application.Undo
    Target.PivotFields("Nom").ClearAllFilters
    For Each pt In Target.PivotFields("Nom").PivotItems
        For i = 0 To x - 1
            If pt.Name = Tnoms(i) Then Voir = True: Exit For
        Next i
        If Voir = False Then pt.Visible = False
        Voir = False
     Next pt
Fin:
    Application.EnableEvents = True

End Sub
Merci beaucoup Chris, ça marche super !
Est-ce que a tout hasard tu saurais adapter le code pour 2 filtres ?

Je comprends suffisamment le code pour l'adapter à mon "vrai" fichier, mais pas assez pour l'étendre à 2 filtres (je ne sais pas du tout coder en VBA) :confused:
 

chris

XLDnaute Barbatruc
RE

Cela risque de mouliner si chaque champ a beaucoup de valeurs
Noms correspondant à Champ1 et Champ 2 à adapter
VB:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'Empécher tout autre modification que le filtre de champ Nom
    If Me.ProtectContents = False Then Exit Sub
    Me.Protect Password:="toto", userinterfaceonly:=True, DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowUsingPivotTables:=True
    
    Dim Tchamp1, Tchamp2, Champ1 As String, Champ2 As String
    
    Champ1 = "Nom"
    Champ2 = "Commercial"
    
    Dim x As Long, y As Long, i As Long, Voir As Boolean
    Dim pt As PivotItem

    ReDim Tchamp1(Target.PivotFields(Champ1).PivotItems.Count)
    x = 0
    For Each pt In Target.PivotFields(Champ1).PivotItems
        If pt.Visible = True Then Tchamp1(x) = pt.Caption: x = x + 1
    Next pt

    ReDim Tchamp2(Target.PivotFields(Champ2).PivotItems.Count)
    y = 0
    For Each pt In Target.PivotFields(Champ2).PivotItems
        If pt.Visible = True Then Tchamp2(y) = pt.Caption: y = y + 1
    Next pt
    If x < 1 And y < 1 Then Application.Undo: GoTo Fin

    On Error GoTo Fin
    Application.EnableEvents = False
    Application.Undo
    
    If x > 0 Then
        ReDim Preserve Tchamp1(x - 1)
        Target.PivotFields("Nom").ClearAllFilters
        For Each pt In Target.PivotFields("Nom").PivotItems
            For i = 0 To x - 1
                If pt.Name = Tchamp1(i) Then Voir = True: Exit For
            Next i
            If Voir = False Then pt.Visible = False
            Voir = False
         Next pt
    End If
    Voir = False
    
    If y > 0 Then
        ReDim Preserve Tchamp2(y - 1)
        Target.PivotFields(Champ2).ClearAllFilters
        For Each pt In Target.PivotFields(Champ2).PivotItems
            For i = 0 To y - 1
                If pt.Name = Tchamp2(i) Then Voir = True: Exit For
            Next i
            If Voir = False Then pt.Visible = False
            Voir = False
         Next pt
    End If
    
Fin:
    Application.EnableEvents = True

End Sub
 

Xylon92

XLDnaute Nouveau
RE

Cela risque de mouliner si chaque champ a beaucoup de valeurs
Noms correspondant à Champ1 et Champ 2 à adapter
VB:
Private Sub Worksheet_PivotTableUpdate(ByVal Target As PivotTable)
'Empécher tout autre modification que le filtre de champ Nom
    If Me.ProtectContents = False Then Exit Sub
    Me.Protect Password:="toto", userinterfaceonly:=True, DrawingObjects:=False, Contents:=True, Scenarios:=True, AllowUsingPivotTables:=True
   
    Dim Tchamp1, Tchamp2, Champ1 As String, Champ2 As String
   
    Champ1 = "Nom"
    Champ2 = "Commercial"
   
    Dim x As Long, y As Long, i As Long, Voir As Boolean
    Dim pt As PivotItem

    ReDim Tchamp1(Target.PivotFields(Champ1).PivotItems.Count)
    x = 0
    For Each pt In Target.PivotFields(Champ1).PivotItems
        If pt.Visible = True Then Tchamp1(x) = pt.Caption: x = x + 1
    Next pt

    ReDim Tchamp2(Target.PivotFields(Champ2).PivotItems.Count)
    y = 0
    For Each pt In Target.PivotFields(Champ2).PivotItems
        If pt.Visible = True Then Tchamp2(y) = pt.Caption: y = y + 1
    Next pt
    If x < 1 And y < 1 Then Application.Undo: GoTo Fin

    On Error GoTo Fin
    Application.EnableEvents = False
    Application.Undo
   
    If x > 0 Then
        ReDim Preserve Tchamp1(x - 1)
        Target.PivotFields("Nom").ClearAllFilters
        For Each pt In Target.PivotFields("Nom").PivotItems
            For i = 0 To x - 1
                If pt.Name = Tchamp1(i) Then Voir = True: Exit For
            Next i
            If Voir = False Then pt.Visible = False
            Voir = False
         Next pt
    End If
    Voir = False
   
    If y > 0 Then
        ReDim Preserve Tchamp2(y - 1)
        Target.PivotFields(Champ2).ClearAllFilters
        For Each pt In Target.PivotFields(Champ2).PivotItems
            For i = 0 To y - 1
                If pt.Name = Tchamp2(i) Then Voir = True: Exit For
            Next i
            If Voir = False Then pt.Visible = False
            Voir = False
         Next pt
    End If
   
Fin:
    Application.EnableEvents = True

End Sub
C'est parfait, merci beaucoup !
Je ne m'en serais très clairement pas sorti tout seul
 

Discussions similaires

Statistiques des forums

Discussions
311 726
Messages
2 081 955
Membres
101 852
dernier inscrit
dthi16088