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

X

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
chris
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...
Trier par date Trier par votes
sylvanu

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
 
Vote positif 0 Vote négatif
X

Xylon92

XLDnaute Nouveau
sylvanu à dit:
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
Cliquez pour agrandir...
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 !
 
Vote positif 0 Vote négatif
sylvanu

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
Vote positif 0 Vote négatif
chris

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
 
Vote positif 0 Vote négatif
X

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 ?
 
Vote positif 0 Vote négatif
chris

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
 
Vote positif 0 Vote négatif
X

Xylon92

XLDnaute Nouveau
chris à dit:
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
Cliquez pour agrandir...
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:
 
Vote positif 0 Vote négatif
chris

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
 
Vote positif 0 Vote négatif
Solution
X

Xylon92

XLDnaute Nouveau
chris à dit:
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
Cliquez pour agrandir...
C'est parfait, merci beaucoup !
Je ne m'en serais très clairement pas sorti tout seul
 
Vote positif 0 Vote négatif

Discussions similaires

V
  • Question
Microsoft 365 VBA - Filtre avancé avec TCD
2
Réponses
16
Affichages
639
nat54
nat54
S
  • Résolu(e)
XL 2016 copier des données d'une feuille à une autre selon critères et protection de la feuille 1
Réponses
6
Affichages
412
steph_29120
S
C
  • Résolu(e)
XL 2016 Problème de TCD avec Champ Date
Réponses
11
Affichages
1 K
chris
chris
L
  • Question
Microsoft 365 TCD VBA SELECTION PLUSIEUR VALEUR
Réponses
3
Affichages
653
merinos-BernardEtang
merinos-BernardEtang
Didier Quilghini
  • Résolu(e)
XL 2019 Définir un nom d'un champ lors d'une macro
2
Réponses
28
Affichages
1 K
vgendron
vgendron
D
  • Question
Microsoft 365 Filtrer sur une feuille protégée et avec code macro
Réponses
5
Affichages
445
dd_76
D
C
  • Résolu(e)
XL 2021 filtrer données puis envoi sur une autre feuille
Réponses
3
Affichages
493
sylvanu
sylvanu
N
  • Question
Microsoft 365 afficher/masquer des lignes en fonction de la valeur d'une cellule qui aura été renseignée par une autre feuille (via un copier/collé automatique)
Réponses
5
Affichages
444
Nel'
N
P
  • Question
XL 2021 Réaliser un échéancier à partir d'un TCD et de données en colonne
Réponses
2
Affichages
687
JHA
J
S
  • Résolu(e)
Microsoft 365 - Conseils pour la structuration d'une base de données -
2 3
Réponses
44
Affichages
3 K
crocrocro
C

Membres actuellement en ligne

10 membres et 98 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 080
Messages
2 116 023
Membres
112 637
dernier inscrit
pseudoinconnu