Discussion :

[Damran]

Bonjour,

Je suis sur Excel 2007. J'ai un tableau (ListObject) sur une feuille protégée et j'aimerai que l'utilisateur puisse y ajouter des lignes via les actions "standard" prévu à cet effet :
- Clique droit sur le tableau -> Insérer->Ligne (au dessus/au dessous)
- ou encore Touche tab/entrée sur la dernière cellule du tableau.

Seulement voilà, j'ai essayé un tas de configuration différentes de protection, rien n'y fait, les options sus-cités sont systématiquement inactives (le menu clique-droit "insertion" est grisé, les touches entrée et tab permettent juste de se déplacer dans le tableau, mais plus d'insérer).

Le mieux que j'obtienne est la possibilité d'insérer une ligne sur la feuille entière (ce qui ajoute bien une ligne à mon tableaux, mais je ne veux ajouter une ligne que à mon tableau, pas à la feuille entière).
J'ai essayé les différentes options de protections de la feuille (même en cochant toutes les cases, cela ne fonctionne pas), j'ai également essayé "Permettre la modification des plages", rien n'y fait, impossible d'insérer une ligne seulement dans mon ListObject.

Quelqu'un aurait-il une solution qui permettent d'utiliser les outils standard d'insertion dans un ListObject (donc sans recourir à un code VBA ferait cette insertion) ?

Merci d'avance !
Damran

[Damran]

Bonjour,

Suite à une demande par MP, je donne ma solution, qui me paraît être bien compliqué au vu de la simplicité de l'action !
1. Lors du clique droit sur un ListObject, modifier le menu contextuel "List Range Popup" pour créer 2 entrées : "Suppression" et "Insertion"
Dans le code de "ThisWorkBook"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Private Sub Workbook_SheetBeforeRightClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    MonCliqueDroit Sh, Target, False
End Sub

Puis dans un module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
Function MonCliqueDroit (ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Target.ListObject Is Nothing Then       
        exit function
  end if
 
   Call SupprimerControlAjoute ""List Range Popup""
 
Set ContextMenu = Application.CommandBars("List Range Popup") 'List Range Layout Popup
    ContextMenu.Reset
 
  ' Add one custom button to the Cell context menu.
    With ContextMenu.Controls.Add(Type:=msoControlButton, before:=1)
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "zSupprimerLignes"
        .FaceId = 293
        .Caption = "Supprimer une ou des lignes"
        .Tag = "My_Cell_Control_Tag"
    End With
 
    With ContextMenu.Controls.Add(Type:=msoControlButton, before:=1)
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "zSupprimerLignes"
        .FaceId = 296
        .Caption = "Insérer une ou des lignes"
        .Tag = "My_Cell_Control_Tag"
    End With
    ContextMenu.Controls(3).BeginGroup = True
 
end sub

"SupprimerControlAjoute" est une fonction qui supprime tout control dont le tag comporte la valeur "My_Cell_Control_Tag". Ceci évite que les contrôles créés ne le soit à chaque appel.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub SupprimerControlAjoute(sName)
    Dim ContextMenu As CommandBar
    Dim ctrl As CommandBarControl
 
    Set ContextMenu = Application.CommandBars(sName)
 
    For Each ctrl In ContextMenu.Controls
        If ctrl.Tag = "My_Cell_Control_Tag" Then
            ctrl.Delete
        End If
    Next ctrl
End Sub

2. Créer la fonction "zSupprimerLignes" :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Sub zSupprimerLignes()
Set r = Selection
  For i = 1 To r.Rows.Count
    r.ListObject.ListRows(r.Row - r.ListObject.Range.Row).Delete
  Next
End Sub

Après il faut gérer les droits d'écriture :
- Enregistrer l'état d'écriture
- Désactiver la lecture seul
- Réaliser la suppression
- Rétablir l'état d'écriture préalablement enregistré

Et voilà, bon courage !

Cdt
Damran

[Damran]

Voici un exemple en PJ

Cdt
Damran

[Pierre Dumas]

Puis dans un module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 
Function MonCliqueDroit (ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If Target.ListObject Is Nothing Then       
        exit function
  end if
 
   Call SupprimerControlAjoute ""List Range Popup""
 
Set ContextMenu = Application.CommandBars("List Range Popup") 'List Range Layout Popup
    ContextMenu.Reset
 
  ' Add one custom button to the Cell context menu.
    With ContextMenu.Controls.Add(Type:=msoControlButton, before:=1)
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "zSupprimerLignes"
        .FaceId = 293
        .Caption = "Supprimer une ou des lignes"
        .Tag = "My_Cell_Control_Tag"
    End With
 
    With ContextMenu.Controls.Add(Type:=msoControlButton, before:=1)
        .OnAction = "'" & ThisWorkbook.Name & "'!" & "zSupprimerLignes"
        .FaceId = 296
        .Caption = "Insérer une ou des lignes"
        .Tag = "My_Cell_Control_Tag"
    End With
    ContextMenu.Controls(3).BeginGroup = True
 
end sub

Merci beaucoup pour cette solution. Elle est effectivement lourde pour quelquechose qui parait simple.
Encore une possibilité d'amélioration d'Excel

Toutefois, dans le code proposé, il me semble que pour le deuxième menu du clic droit il est mentionné d'aller dans la macro zSupprimerLignes alors qu'on veut en ajouter... Ce ne doit être qu'une erreur de copier-coller. Et un oubli d'une macro pour ajouter...
Pierre

[Fvandermeulen]

Salut à tous,

Pour autant qu'on ne parle que d'ajouter une ligne dans le tableau formaté, la macro évènementielle de feuille BeforeRightClick réduit fortement le code.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
 
If MsgBox("Voulez vous ajouter une ligne ?", vbYesNo, "Le monsieur te demande") = vbYes Then
    ActiveSheet.Unprotect LeMotDePasse
    ActiveSheet.Cells.ListObject.ListRows.Add (ActiveCell.Row)
    ActiveSheet.Protect LeMotDePasse
End If
Cancel = True
End Sub

A+