RESOLU : Menu personnalisé - réglage de la hiérarchie

Victor21

Victor21

XLDnaute Barbatruc
Bonsoir à tous !!!

Je galère depuis des heures pour régler la hiérarchisation des mes commandes dans un menu personnalisé.
Le code que je tente en vain d'adapter est de Ole P. Erlandsen :
VB: 
Option Explicit

Sub NouveauMenu()
    'adapté d'un code de Ole P. Erlandsen

    'Déclarer les variables
    Dim cbMenu As CommandBarControl
    Dim cbSubMenu As CommandBarControl

    'Effacer le menu s'il existe déjà
    SupprimeMenu

    'Créer un nouveau menu "Taxes"
    Set cbMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
    With cbMenu
        .Caption = "&Taxes"
        .Tag = "Taxes"
        .BeginGroup = False
    End With

    'Sortir si le menu n'est pas trouvé
    If cbMenu Is Nothing Then Exit Sub

    '1.....Sauvegarder les données
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Sauvegarder les données"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .FaceId = 1975
    End With

    '2.....Gérer les bases
    Set cbSubMenu = cbMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu
        .Caption = "&Gérer les bases"
        .Tag = "Gérer les bases"
        .BeginGroup = True
    End With

    '2.1.....Ajouter un sous-menu "Taxe" au sous-menu "Gérer les bases"
    Set cbSubMenu = cbSubMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu
        .Caption = "&Taxe"
        .Tag = "Taxe"
        .BeginGroup = True
    End With

    '2.1.1.....Afficher Taxe
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Afficher la base"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2499
        .State = msoButtonDown
    End With

    '2.1.2.....Masquer Taxe
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Masquer la base"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2499
        .State = msoButtonDown
    End With

    '2.2.....Ajouter un sous-menu "INSEE" au sous-menu "Gérer les bases"
    Set cbSubMenu = cbSubMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu
        .Caption = "&INSEE"
        .Tag = "INSEE"
        .BeginGroup = False
    End With

    '2.2.1.....Afficher INSEE
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Afficher la base"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2499
        .State = msoButtonDown
    End With

    '2.2.2.....Masquer INSEE
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Masquer la base"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2499
        .State = msoButtonDown
    End With

    '3..... Historique
    Set cbSubMenu = cbMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu
        .Caption = "&Historique"
        .Tag = "Gestion des bases"
        .BeginGroup = True
    End With

    '3.1.....Ajouter "Ouvrir" au sous-menu Historique
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Ouvrir l'historique"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2937
        .State = msoButtonDown
    End With

    '3.2.....Ajouter "Fermer" au sous-menu Historique
    With cbSubMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Fermer l'historique"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 4088
        .State = msoButtonDown
    End With

    '4..... Aide
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Aide"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 926
        .BeginGroup = True
    End With

    '5..... Supprimer ce menu
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Supprimer ce menu"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 3265
        .BeginGroup = True
    End With

    'Vider les variables
    Set cbSubMenu = Nothing
    Set cbMenu = Nothing

End Sub
Le problème se situe au point 2.2., qui refuse obstinément de se placer au même niveau que le 2.1.

Je joins un fichier qui, je pense, sera plus clair que mes explications.
D'avance merci à qui pourra me dépanner et, surtout, m'expliquer où se situe mon erreur.

Edit : une erreur sur le croquis, et un bug lors de la recopie de la macro "supprimer" : rectifiés dans le noubeau fichier...
Merci de ne pas m'en tenir rigueur.
 

Pièces jointes

  • MenuPB5.xls
    46.5 KB · Affichages: 71
Dernière édition:
Trier par date Trier par votes
Victor21

Victor21

XLDnaute Barbatruc
Re : Menu personnalisé - réglage de la hiérarchie

Bonsoir, Hippolite.

Une mine, ce Jacques...
C'est ce que je ferai en dernier recours pour le cas -improbable- où personne ne pourrait m'expliquer mon erreur.
Dans tous les cas, merci d'avoir pris la peine de me lire et de me répondre.
 
Vote positif 0 Vote négatif
Hippolite

Hippolite

XLDnaute Accro
Re : Menu personnalisé - réglage de la hiérarchie

Re,
ça devrait donner quelque chose comme
VB: 
Sub NouveauMenu()
    'adapté d'un code de Ole P. Erlandsen

    'Déclarer les variables
   Dim cbMenu As CommandBarControl
    Dim cbSubMenu As CommandBarControl ' A COMPLETER

    'Effacer le menu s'il existe déjà
   SupprimeMenu

    'Créer un nouveau menu "Taxes"
   Set cbMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
    With cbMenu
        .Caption = "&Taxes"
        .Tag = "Taxes"
        .BeginGroup = False
    End With

    'Sortir si le menu n'est pas trouvé
   If cbMenu Is Nothing Then Exit Sub

    '1.....Sauvegarder les données
   With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Sauvegarder les données"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .FaceId = 1975
    End With

    '2.....Gérer les bases
   Set cbSubMenu2 = cbMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu2
        .Caption = "&Gérer les bases"
        .Tag = "Gérer les bases"
        .BeginGroup = True
    End With

    '2.1.....Ajouter un sous-menu "Taxe" au sous-menu "Gérer les bases"
   Set cbSubMenu21 = cbSubMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu21
        .Caption = "&Taxe"
        .Tag = "Taxe"
        .BeginGroup = True
    End With

    '2.1.1.....Afficher Taxe
   With cbSubMenu21.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Afficher la base"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2499
        .State = msoButtonDown
    End With

    '2.1.2.....Masquer Taxe
   With cbSubMenu21.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Masquer la base"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2499
        .State = msoButtonDown
    End With

    '2.2.....Ajouter un sous-menu "INSEE" au sous-menu "Gérer les bases"
   Set cbSubMenu22 = cbSubMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu22
        .Caption = "&INSEE"
        .Tag = "INSEE"
        .BeginGroup = False
    End With

    '2.2.1.....Afficher INSEE
   With cbSubMenu22.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Afficher la base"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2499
        .State = msoButtonDown
    End With

    '2.2.2.....Masquer INSEE
   With cbSubMenu22.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Masquer la base"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2499
        .State = msoButtonDown
    End With

    '3..... Historique
   Set cbSubMenu3 = cbMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu3
        .Caption = "&Historique"
        .Tag = "Gestion des bases"
        .BeginGroup = True
    End With

    '3.1.....Ajouter "Ouvrir" au sous-menu Historique
   With cbSubMenu3.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Ouvrir l'historique"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2937
        .State = msoButtonDown
    End With

    '3.2.....Ajouter "Fermer" au sous-menu Historique
   With cbSubMenu3.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Fermer l'historique"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 4088
        .State = msoButtonDown
    End With

    '4..... Aide
   With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Aide"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 926
        .BeginGroup = True
    End With

    '5..... Supprimer ce menu
   With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Supprimer ce menu"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 3265
        .BeginGroup = True
    End With

    'Vider les variables       
   Set cbSubMenu = Nothing  '      A COMPLETER
    Set cbMenu = Nothing

End Sub
A+
 
Vote positif 0 Vote négatif
Victor21

Victor21

XLDnaute Barbatruc
Re : Menu personnalisé - réglage de la hiérarchie

Merci, Hippolite.

Tes conseils et le dernier lien m'ont permis de résoudre "en beauté" ce problème.

Le code corrigé pour le cas où il pourrait être utile :
VB: 
Sub NouveauMenu()
    'adapté d'un code de Ole P. Erlandsen

    'Déclarer les variables
    Dim cbMenu As CommandBarControl
    Dim cbSubMenu As CommandBarControl
    Dim cbSubMenu2 As CommandBarControl
    Dim cbSubMenu21 As CommandBarControl
    Dim cbSubMenu22 As CommandBarControl
    Dim cbSubMenu3 As CommandBarControl   
    'Effacer le menu s'il existe déjà
    SupprimeMenu

    'Créer un nouveau menu "Taxes"
    Set cbMenu = Application.CommandBars(1).Controls.Add(msoControlPopup, , , , True)
    With cbMenu
        .Caption = "&Taxes"
        .Tag = "Taxes"
        .BeginGroup = False
    End With

    'Sortir si le menu n'est pas trouvé
    If cbMenu Is Nothing Then Exit Sub

    '1.....Sauvegarder les données
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Sauvegarder les données"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .FaceId = 1975
    End With

    '2.....Gérer les bases
    Set cbSubMenu2 = cbMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu2
        .Caption = "&Gérer les bases"
        .Tag = "Gérer les bases"
        .BeginGroup = True
    End With

    '2.1.....Ajouter un sous-menu "Taxe" au sous-menu "Gérer les bases"
    Set cbSubMenu21 = cbSubMenu2.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu21
        .Caption = "&Taxe"
        .Tag = "Taxe"
        .BeginGroup = True
    End With

    '2.1.1.....Afficher Taxe
    With cbSubMenu21.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Afficher la base"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2499
        .State = msoButtonDown
    End With

    '2.1.2.....Masquer Taxe
    With cbSubMenu21.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Masquer la base"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2499
        .State = msoButtonDown
    End With

    '2.2.....Ajouter un sous-menu "INSEE" au sous-menu "Gérer les bases"
    Set cbSubMenu22 = cbSubMenu2.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu22
        .Caption = "&INSEE"
        .Tag = "INSEE"
        .BeginGroup = False
    End With

    '2.2.1.....Afficher INSEE
    With cbSubMenu22.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Afficher la base"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2499
        .State = msoButtonDown
    End With

    '2.2.2.....Masquer INSEE
    With cbSubMenu22.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Masquer la base"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2499
        .State = msoButtonDown
    End With

    '3..... Historique
    Set cbSubMenu3 = cbMenu.Controls.Add(msoControlPopup, 1, , , True)
    With cbSubMenu3
        .Caption = "&Historique"
        .Tag = "Gestion des bases"
        .BeginGroup = True
    End With

    '3.1.....Ajouter "Ouvrir" au sous-menu Historique
    With cbSubMenu3.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Ouvrir l'historique"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 2937
        .State = msoButtonDown
    End With

    '3.2.....Ajouter "Fermer" au sous-menu Historique
    With cbSubMenu3.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Fermer l'historique"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 4088
        .State = msoButtonDown
    End With

    '4..... Aide
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Aide"
        .OnAction = ThisWorkbook.Name & "!Mamacro"
        .Style = msoButtonIconAndCaption
        .FaceId = 926
        .BeginGroup = True
    End With

    '5..... Supprimer ce menu
    With cbMenu.Controls.Add(msoControlButton, 1, , , True)
        .Caption = "&Supprimer ce menu"
        .OnAction = ThisWorkbook.Name & "!SupprimeMenu"
        .Style = msoButtonIconAndCaption
        .FaceId = 3265
        .BeginGroup = True
    End With
    
    'Vider les variables
    Set cbSubMenu = Nothing
    Set cbSubMenu2 = Nothing
    Set cbSubMenu21 = Nothing
    Set cbSubMenu22 = Nothing
    Set cbSubMenu3 = Nothing
    Set cbMenu = Nothing

End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

D
  • Résolu(e)
Microsoft 365 Création d'une barre personnalisée dans Excel
2 3
Réponses
35
Affichages
2 K
laurent950
laurent950
Lu76Fer
  • Question
XL 2016 Démo pour positionner un UserForm ou ContextMenu sur la grille (Toute version)
10 11 12
Réponses
178
Affichages
7 K
TooFatBoy
TooFatBoy
laurent950
  • Question
XL 2016 Modele Objet "Application.CommandBars" Chemin Classeur A Pour Création dans un Autres Classeurs B
Réponses
1
Affichages
1 K
laurent950
laurent950
A
  • Question
XL 2016 Placer icone devant menu contextuel
Réponses
0
Affichages
789
alain160
A
S
  • Question
Lancer deux Macros avec un menu contextuel
Réponses
4
Affichages
1 K
softimen
S
S
  • Question
Duplication de la ligne avec incrementation
Réponses
1
Affichages
819
softimen
S
J
  • Question
XL 2010 [Résolu] Menu personnalisé récalcitrant..
Réponses
4
Affichages
1 K
jmh1
J
G
  • Question
XL 2013 Boucle sur Commandbars
2
Réponses
24
Affichages
4 K
Roland_M
Roland_M
gosselien
  • Question
erreur de création de menu perso et chargement du personnal.xlb
Réponses
0
Affichages
1 K
gosselien
gosselien
F
  • Question
VBA modif Menu contextuel d'un tableau
Réponses
3
Affichages
4 K
Yohannf
Y

Membres actuellement en ligne

8 membres et 107 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
314 651
Messages
2 111 553
Membres
111 199
dernier inscrit
mavoungou regis