Création menu contextuel avec sous menu Texte Filter

Version imprimable

Bonjour à tous et bon début de semaine,

Je rencontre un problème avec la création d'un menu contextuel contenant un sous menu Filtre texte ou date ou chiffre
Le menu se crée bien, mais le sous menu reste vide

Code:

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
Public Sub CREATE_POPUPMENU_Tri() 'Menu contextuel Tri

    'on déclare nos variables
    Dim mCmdBar As CommandBar
    Dim mBtn As CommandBarButton
    
    'DoCmd.SetWarnings False
    'suppression du Menu existant
    'il faut toujours supprimer le menu avant de le re-créer
    On Error Resume Next
    Application.CommandBars("Tri").Delete
    
    'génération du menu contextuel
    'on ajoute notre menu contextuel en lui précisant le type d’affichage de barre souhaité
    Set mCmdBar = Application.CommandBars.Add("Tri", msoBarPopup)

    'on ajoute les boutons à notre menu contextuel
    With mCmdBar
          .Controls.Add msoControlButton, 21, , , True '.BeginGroup = True     'Cut
          .Controls.Add msoControlButton, 19, , , True    'Copy
          .Controls.Add msoControlButton, 22, , , True    'Paste
          .Controls.Add msoControlButton, 4016, , , True '.BeginGroup = True   'Sort Ascending
          .Controls.Add msoControlButton, 4017, , , True  'Sort Decending
          .Controls.Add msoControlButton, 640, , , True '.BeginGroup = True  'Filter By Selection
          .Controls.Add msoControlButton, 605, , , True   'Remove Filter/Sort
          .Controls.Add msoControlButton, 3017, , , True  'Filter Excluding Selection
          .Controls.Add msoControlButton, 10068, , , True 'Filter equals xx
          .Controls.Add msoControlButton, 10071, , , True 'Filter not equal to xx
          .Controls.Add msoControlButton, 10076, , , True 'Filter contains xx
          .Controls.Add msoControlButton, 10089, , , True 'Filter does not contains  xx
          .Controls.Add msoControlButton, 141, , , True   'Find in form
          .Controls.Add msoControlButton, 31581, , , True   'Text filters ------> le sous menu qui reste vide
          .Controls.Add msoControlButton, 10077, , , True 'Filter equals xx
          .Controls.Add msoControlButton, 10078, , , True 'Filter not equal to xx
          .Controls.Add msoControlButton, 10079, , , True 'Filter beings with xx
          .Controls.Add msoControlButton, 12696, , , True 'Filter does not beings with xx
          .Controls.Add msoControlButton, 10080, , , True 'Filter contains xx
          .Controls.Add msoControlButton, 10081, , , True 'Filter does not contains xx
          .Controls.Add msoControlButton, 10082, , , True 'Filter ends with xx
          .Controls.Add msoControlButton, 10083, , , True 'Filter ends with xx
          .Controls.Add msoControlButton, 12697, , , True 'Filter does not ends with xx
          .Controls.Add msoControlButton, 10062, , , True 'Filter between
          .Controls.Add msoControlButton, 12698, , , True 'Filter before xx
          .Controls.Add msoControlButton, 25, , , True '.BeginGroup = True     'Report Zoom
          .Controls.Add msoControlButton, 4, , , True     'Report Print
   End With
End Sub

J'ai esaayé plusieurs fois, ça a fonctionné une seule fois dans un champ, quand j'ai mis le nom du menu dans un autre champ ça n'a plus fonctionné, je comprend vraimant pas ce qui se passe.

Merci pour votre aide

06/04/2020, 17h18
Jean-Philippe André

Salut,

c'est pas une histoire de type de control ? msoControlPopup au lieu du msoControlButton ?

Salut à tous,

Voilà le Menu Contextuel Tri finalisé
L'avantage du sous-menu Text Filters, c'est qu'il change de lui même le titre du sous-menu suivant si on est sur du text = Filtres de texte, sur une date = Filtres de dates, sur un chiffre = Filtres de chiffres et il rend invisible ou disable certain bouton suivant un de ces 3 cas.
Et également, suivant si on est dans le champ ou si il y a une sélection, il fait la même chose que si dessus.

Voici le code

Code:

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
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
Sub CREATE_POPUPMENU_Tri()
    Dim newMenu As CommandBarControl
 
    Dim newMenu_Essai As CommandBar
    Dim cmb As CommandBar
    On Error Resume Next
 
    'Si le Menu existe déjà on le supprime
    CommandBars("Tri").Delete
 
    Set cmb = CommandBars.Add("Tr", msoBarPopup, False, False)
 
    With cmb
 
        .Controls.Add(msoControlButton, 21, , , True).BeginGroup = True     'Cut
        .Controls.Add msoControlButton, 19, , , True    'Copy
        .Controls.Add msoControlButton, 22, , , True    'Paste
 
        'Le Sous-Menu
        Set newMenu = .Controls.Add(msoControlButton, 31581) 'Sous Menu Text Filters
 
        Set mBtn = cmb.Controls.Add(msoControlButton, 1567) 'Quitter le Formulaire
        With mBtn
            'Bouton avec une icône et un libellé
            .Style = msoButtonIconAndCaption
            .Caption = "&Quitter le formulaire"
        End With
 
        ' Les Boutons qui sont dans le sous-Menu Text Filters
        newMenu.Controls.Add msoControlButton, 210, , , True  'Sort Ascending
        newMenu.Controls.Add msoControlButton, 211, , , True  'Sort Decending
        newMenu.Controls.Add msoControlButton, 640, , , True  'Filter By Selection
        newMenu.Controls.Add msoControlButton, 605, , , True  'Remove Filter/Sort
        newMenu.Controls.Add msoControlButton, 3017, , , True 'Filter Excluding Selection
 
        newMenu.Controls.Add(msoControlButton, 10068, , , False).BeginGroup = True 'Filter equals xx
        newMenu.Controls.Add msoControlButton, 10071, , , False 'Filter not equal to xx
        newMenu.Controls.Add msoControlButton, 10076, , , False  'Filter contains xx
        newMenu.Controls.Add msoControlButton, 10089, , , False  'Filter does not contains  xx
        newMenu.Controls.Add(msoControlButton, 141, , , False).BeginGroup = True 'Find in form
 
        newMenu.Controls.Add msoControlButton, 10077, , , True   'Filter equals xx
        newMenu.Controls.Add msoControlButton, 10078, , , True   'Filter not equal to xx
        newMenu.Controls.Add msoControlButton, 10079, , , True   'Filter beings with xx
        newMenu.Controls.Add msoControlButton, 12696, , , True   'Filter does not beings with xx
        newMenu.Controls.Add msoControlButton, 10080, , , True   'Filter contains xx
        newMenu.Controls.Add msoControlButton, 10081, , , True   'Filter does not contains xx
        newMenu.Controls.Add msoControlButton, 10082, , , True   'Filter ends with xx
        newMenu.Controls.Add msoControlButton, 10083, , , True   'Filter ends with xx
        newMenu.Controls.Add msoControlButton, 12697, , , True   'Filter does not ends with xx
        newMenu.Controls.Add msoControlButton, 10062, , , True   'Filter between
        newMenu.Controls.Add msoControlButton, 12698, , , True   'Filter before xx
    End With
 
    Set cmb = Nothing
    Set newMenu = Nothing
 
End Sub

A+