XL 2016 Supprimer "Rechercher dans les menus" du menu contextuel de cellule Excel

[jurassic pork]

Hello,
je cherche à supprimer l'élément "Rechercher dans les menus" du menu contextuel de cellule Excel (clic droit dans une cellule) qui se trouve tout en haut de ce menu.
Si je supprime tous les éléments avec cette macro VBA :

Sub ClearCellCommandBar()
    Dim item As CommandBarControl
    For Each item In Application.CommandBars("Cell").Controls
        item.Delete
    Next item
End Sub

Il n'y a bien plus rien mais si je mets deux boutons comme ceci (c'est peut-être pas la bonne méthode) :

Sub AddCustomControl()
    Dim control As CommandBarControl
    Set control = Application.CommandBars("Cell").Controls.Add(msoControlButton)
    control.Caption = "Reprendre le Questionnaire"
    control.OnAction = "Feuil5.Reprendre"
    Set control = Application.CommandBars("Cell").Controls.Add(msoControlButton)
    control.Caption = "Débuter le Questionnaire"
    control.OnAction = "Feuil5.Reinit"  
End Sub

J'ai bien mes deux commandes mais j'ai l'élément Rechercher dans les menus qui est revenu et alors on peut se ballader dans les menus.
Pour revenir à un état initial :

Sub ResetCellCommandBar()
    Application.CommandBars("Cell").Reset
End Sub

Ami calmant, J.P

 

[fanch55]

Salut JP,
C'est le fonctionnement normal des commandbars "Cell" et "List range popup"
Pas d'éléments, pas de recherche dans les éléments, sinon toujours présent ..
Perso, je ne me sers jamais de cette recherche car elle n'est absolument pas contextuelle ni pertinente .
Je préfère me servir de l'événement rightclick , pas besoin de tout remettre en place en sortie de classeur et cela n'impacte pas les autres instances d'Excel .

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Dim Control As Object
Dim Rbar    As CommandBar
Dim Sbar    As String
Const Cb = "ClicDroit"
    Select Case True
        Case Target.Count > 1
       ' Case Not Application.Intersect(Target, [b2:d12]) Is Nothing  ' pour appliquer à une plage
        Case Else
            Cancel = True 'empêche l'affichage normal du menu d'Excel
            On Error Resume Next: CommandBars(Cb).Delete: ' On Error GoTo 0
            Set Rbar = CommandBars.Add(Cb, msoBarPopup, , True)
            With Rbar
                With .Controls.Add(msoControlButton, , , , True)
                    .Caption = "Reprendre le Questionnaire"
                    .OnAction = "'" & Me.CodeName & ".Reprendre'"
                    '.FaceId = 327
                End With
                With .Controls.Add(msoControlButton, , , , True)
                    .Caption = "Débuter le Questionnaire"
                    .OnAction = "'" & Me.CodeName & ".Reinit'"
                    '.FaceId = 327
                End With
                With .Controls.Add(msoControlPopup, , , , True)
                    .Caption = "Plus ..."
                    Sbar = IIf(Target.ListObject Is Nothing, "Cell", "List Range Popup")
                    For Each Control In CommandBars(Sbar).Controls
                        Control.Copy .CommandBar
                    Next
                End With
                Application.ScreenUpdating = True
                .ShowPopup
                .Delete
            End With
    End Select

End Sub
Sub Reprendre()
    MsgBox "Reprendre"
End Sub

 

[patricktoulon]

a c'est pas mal ça @fanch55 on me l'avais jamais faite
copier une barpopup dans un controlpopup d'une bar dynamico
ho c'est beau

 

[jurassic pork]

Hello,
merci fanch55 pour ton code. Je pense effectivement que c'est la meilleure méthode pour maîtriser le clic droit dans les cellules.
Ami calmant, J.P