XL 2016 Problème pour masquer les formules

scoubidou35 · 26 Juin 2021

Bonjour à tous,
J'ai un tableau avec des formules et un code VBA pour ajouter automatiquement un ligne quand la ligne précédente est utilisé.
Je voulais protéger les formules contre la maladresse en les masquant.
Dans pour cela j'ai sélectionné la feuille entière et j'ai décocher "verrouillé" dans mise en forme cellules/Protection
Puis j'ai sélectionné les cellules avec des formules et j'ai sélectionné "Masqué" dans mise en forme cellules/protection
Enfin j'ai protéger la feuille avec un mot de passe (dans le fichier joint il n'y a pas de mot de passe à entrer)

résultat mes formules sont masquées mais lorsque je clique en dehors du tableau pour rajouter une ligne en fait le code VBA ne fonctionne plus.

Y a t-il une solution ou pas?

Merci d'avance

Bonne journée

fanch55 · 6 Juillet 2021

Pour un appel universel depuis plusieurs feuilles ou onglets,
Mettre le code suivant dans un module :

VB:

Public Sub Sheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean, Tabref As ListObject)
    Select Case True
        Case Not Application.Intersect(Target, Tabref.HeaderRowRange) Is Nothing
        Case Application.Intersect(Target, Tabref.DataBodyRange) Is Nothing
        Case Else
            Cancel = True 'empêche l'affichage du menu d'Excel
            With Application.CommandBars("Cell")
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .FaceId = 1088: .Caption = "Supprimer la ligne de Table"
                    .OnAction = "'Do_Tab " & "[" & Tabref & "].listobject" & "'"...

scoubidou35 · 29 Juin 2021

fanch55 à dit:

Après simplification :
( c'est imparfait car il ne tient pas compte des sélections multiples, mais c'est un exemple ... )

Code:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Select Case True
        Case Not Application.Intersect(Target, [Tab_Fertilisation[#Headers]]) Is Nothing
        Case Application.Intersect(Target, [Tab_FERTILISATION[#Data]]) Is Nothing
        Case Else
            Cancel = True 'empêche l'affichage du menu d'Excel
            With Application.CommandBars("Cell")
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .FaceId = 1088: .Caption = "Supprimer la ligne de Table"
                    .OnAction = Me.CodeName & ".Do_Tab"
                End With
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .FaceId = 1142: .Caption = "Ajouter une ligne de Table içi"
                    .OnAction = Me.CodeName & ".Do_Tab"
                End With
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .FaceId = 1145: .Caption = "Ajouter une ligne en fin de Table"
                    .OnAction = Me.CodeName & ".Do_Tab"
                    .BeginGroup = True
                End With
                .ShowPopup
                For Each Control In .Controls
                    If Not Control.BuiltIn Then Control.Delete
                Next
            End With
    End Select
End Sub
Sub Do_Tab()

Me.Unprotect
    Application.EnableEvents = False
    Frow = Selection.Row
    Trow = [Tab_FERTILISATION[#Data]].Row
    Select Case CommandBars.ActionControl.FaceId
    Case 1088: [Tab_FERTILISATION].Rows(Frow - Trow + 1).Delete             ' Supprimer
    Case 1142: [Tab_FERTILISATION].ListObject.ListRows.Add Frow - Trow + 1  ' Ajouter içi
    Case 1145: [Tab_FERTILISATION].ListObject.ListRows.Add                  ' Ajouter en fin de table
    End Select
    Application.EnableEvents = True
Me.Protect

End Sub

Merci fanch 55, je viens de tester et cela réponds à ma demande cela me permet de protéger mes formules et de les masquer, et si j'ai des données sur les colonnes en dehors du tableau et que je supprime ou ajoute une ligne je ne perds pas l'info.
Je vais voir si j'arrive à trouver la solution pour pouvoir faire une selection multiple.

scoubidou35 · 5 Juillet 2021

Bonsoir,
Je reviens aujourd'hui car j'ai avancé sur mon fichier et comme j'ai plusieurs feuilles dans mon classeur sur le même modèle que mon fichier (avec des tables).
J'ai donc fait un copier/coller du code dans chacune des feuilles en modifiant le nom de la table.
mais maintenant j'ai ce bug et je ne sais pas pourquoi. Et sinon j'ai essayé de trouver une solution pour une sélection multiple mais en vain.

Bernard_XLD · 5 Juillet 2021

Bonjour le fil, le forum

le programme vous le dit, votre variable control n'est pas définie, vous devez avoir un option explicit en début de module ce qui oblige à déclarer toutes les variables
déclarez votre variable en début de sub avec
Dim Control
je vous conseille quand même d'utiliser à la place de control un autre nom qui ne risque pas de confusion
Dim Ctrl_en_Cours par exemple ou n'importe quoi d'autre qu'un nom d'objet, de propriété, de fonction ou de méthode.

Bien cordialement, @+

scoubidou35 · 6 Juillet 2021

Yeahou à dit:
Bonjour le fil, le forum

le programme vous le dit, votre variable control n'est pas définie, vous devez avoir un option explicit en début de module ce qui oblige à déclarer toutes les variables
déclarez votre variable en début de sub avec
Dim Control
je vous conseille quand même d'utiliser à la place de control un autre nom qui ne risque pas de confusion
Dim Ctrl_en_Cours par exemple ou n'importe quoi d'autre qu'un nom d'objet, de propriété, de fonction ou de méthode.

Bien cordialement, @+

Bonjour à tous et Yeahou
En effet, j'ai bien une option explicit en début et maintenant que j'ai déclaré les variables ca fonctionne. Merci beaucoup.
@+

fanch55 · 6 Juillet 2021

Pour un appel universel depuis plusieurs feuilles ou onglets,
Mettre le code suivant dans un module :

VB:

Public Sub Sheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean, Tabref As ListObject)
    Select Case True
        Case Not Application.Intersect(Target, Tabref.HeaderRowRange) Is Nothing
        Case Application.Intersect(Target, Tabref.DataBodyRange) Is Nothing
        Case Else
            Cancel = True 'empêche l'affichage du menu d'Excel
            With Application.CommandBars("Cell")
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .FaceId = 1088: .Caption = "Supprimer la ligne de Table"
                    .OnAction = "'Do_Tab " & "[" & Tabref & "].listobject" & "'"
                End With
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .FaceId = 1142: .Caption = "Ajouter une ligne de Table içi"
                    .OnAction = "'Do_Tab " & "[" & Tabref & "].listobject" & "'"
                End With
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .FaceId = 1145: .Caption = "Ajouter une ligne en fin de Table"
                    .OnAction = "'Do_Tab " & "[" & Tabref & "].listobject" & "'"
                    .BeginGroup = True
                End With
                .ShowPopup
                Dim Control
                For Each Control In .Controls
                    If Not Control.BuiltIn Then Control.Delete
                Next
            End With
    End Select
End Sub
Sub Do_Tab(Tabref As ListObject)

ActiveSheet.Unprotect
    Application.EnableEvents = False
    For i = Selection.Rows.Count To 1 Step -1
        Frow = Selection.Rows(i).Row
        Trow = Tabref.DataBodyRange.Row
        Select Case CommandBars.ActionControl.FaceId
        Case 1088: Tabref.HeaderRowRange.Rows(Frow - Trow + 1).Delete   ' Supprimer
        Case 1142: Tabref.ListRows.Add Frow - Trow + 1   ' Ajouter içi
        Case 1145: Tabref.ListRows.Add                   ' Ajouter en fin de table
        End Select
    Next
    Application.EnableEvents = True
ActiveSheet.Protect

End Sub

Puis dans chaque feuille ou onglet en indiquant la table :

Code:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Sheet_BeforeRightClick Target, Cancel, [Tab_FERTILISATION].ListObject
End Sub

Nota: le multi-line est traité ...

scoubidou35 · 7 Juillet 2021

fanch55 à dit:

Pour un appel universel depuis plusieurs feuilles ou onglets,
Mettre le code suivant dans un module :

VB:

Public Sub Sheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean, Tabref As ListObject)
    Select Case True
        Case Not Application.Intersect(Target, Tabref.HeaderRowRange) Is Nothing
        Case Application.Intersect(Target, Tabref.DataBodyRange) Is Nothing
        Case Else
            Cancel = True 'empêche l'affichage du menu d'Excel
            With Application.CommandBars("Cell")
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .FaceId = 1088: .Caption = "Supprimer la ligne de Table"
                    .OnAction = "'Do_Tab " & "[" & Tabref & "].listobject" & "'"
                End With
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .FaceId = 1142: .Caption = "Ajouter une ligne de Table içi"
                    .OnAction = "'Do_Tab " & "[" & Tabref & "].listobject" & "'"
                End With
                With .Controls.Add(msoControlButton, 1, , 1, True)
                    .FaceId = 1145: .Caption = "Ajouter une ligne en fin de Table"
                    .OnAction = "'Do_Tab " & "[" & Tabref & "].listobject" & "'"
                    .BeginGroup = True
                End With
                .ShowPopup
                Dim Control
                For Each Control In .Controls
                    If Not Control.BuiltIn Then Control.Delete
                Next
            End With
    End Select
End Sub
Sub Do_Tab(Tabref As ListObject)

ActiveSheet.Unprotect
    Application.EnableEvents = False
    For i = Selection.Rows.Count To 1 Step -1
        Frow = Selection.Rows(i).Row
        Trow = Tabref.DataBodyRange.Row
        Select Case CommandBars.ActionControl.FaceId
        Case 1088: Tabref.HeaderRowRange.Rows(Frow - Trow + 1).Delete   ' Supprimer
        Case 1142: Tabref.ListRows.Add Frow - Trow + 1   ' Ajouter içi
        Case 1145: Tabref.ListRows.Add                   ' Ajouter en fin de table
        End Select
    Next
    Application.EnableEvents = True
ActiveSheet.Protect

End Sub

Puis dans chaque feuille ou onglet en indiquant la table :

Code:

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Sheet_BeforeRightClick Target, Cancel, [Tab_FERTILISATION].ListObject
End Sub

Nota: le multi-line est traité ...

Merci beaucoup fanch55, ça marche super!!!!
Mais en testant je me suis apercu que quand ma feuille est protégée je peux donc supprimer et ajouter des lignes mais à cause (ou graces à) une erreur de manip je me suis apercu que je ne peux pas revenir en arrière et annuler ma manip. Serais tu comment faire. J'ai tester en cochant et décochant les autorisations mais en vain

fanch55 · 7 Juillet 2021

scoubidou35 à dit:
Merci beaucoup fanch55, ça marche super!!!!
Mais en testant je me suis apercu que quand ma feuille est protégée je peux donc supprimer et ajouter des lignes mais à cause (ou graces à) une erreur de manip je me suis apercu que je ne peux pas revenir en arrière et annuler ma manip. Serais tu comment faire. J'ai tester en cochant et décochant les autorisations mais en vain

Les opérations effectuées via le code ne peuvent pas être annulées.
Le seul moyen est de prévoir un message demandant confirmation ou non avant les opérations, ce qui risque de devenir fastidieux .

scoubidou35 · 7 Juillet 2021

fanch55 à dit:
Les opérations effectuées via le code ne peuvent pas être annulées.
Le seul moyen est de prévoir un message demandant confirmation ou non avant les opérations, ce qui risque de devenir fastidieux .

Ok, je m'en suis douté vu que je n'ai rien trouvé sur internet . Donc il faudra faire attention mais bon normalement nous ne passerons pas notre temps à supprimer des lignes. Donc je laisse comme ça. En tout cas merci pour votre aide et le temps passé.
Bonne soirée

XL 2016 Problème pour masquer les formules

scoubidou35

XLDnaute Occasionnel

Pièces jointes

fanch55

scoubidou35

XLDnaute Occasionnel

scoubidou35

XLDnaute Occasionnel

Pièces jointes

Bernard_XLD

XLDnaute Barbatruc

scoubidou35

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

scoubidou35

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

scoubidou35

XLDnaute Occasionnel

Discussions similaires