bonjour à tous
'Création d'un menu avec sous menus dans la barre des menus d'Excel
'd'après E. Tissot, mpfe
Sub Creer_Menu()
Dim NewMenu As CommandBarPopup
Dim NewSubMenu As CommandBarPopup
Dim NewButton As CommandBarButton
' menus d'Excel
nomBarre = 'Worksheet menu bar'
'ajouter un menu
Set NewMenu = Application.CommandBars(nomBarre).Controls.Add _
(Type:=msoControlPopup)
NewMenu.Caption = 'Classement'
'ajouter un sous-menu au menu
Set NewSubMenu = NewMenu.Controls.Add(Type:=msoControlPopup)
NewSubMenu.Caption = 'Choix colonnes'
'ajouter un bouton au sous-menu
Set NewButton = NewSubMenu.Controls.Add(Type:=msoControlButton)
With NewButton
.Caption = 'Appel UserForm1'
.FaceId = 317
.OnAction = 'AppelUsf'
End With
' 'ajouter un sous-menu au menu
' Set NewSubMenu = NewMenu.Controls.Add(Type:=msoControlPopup)
' NewSubMenu.Caption = 'Feuille classement'
'
' 'ajouter un bouton au sous-menu
' Set NewButton = NewSubMenu.Controls.Add(Type:=msoControlButton)
' With NewButton
' .Caption = 'Classement participants'
' .FaceId = 317
' .OnAction = 'Classement'
' End With
'
' 'ajouter un bouton au menu
' Set NewButton = NewMenu.Controls.Add(Type:=msoControlButton)
' With NewButton
' .Caption = 'Macro 2'
' .BeginGroup = True
' .FaceId = 316
' .OnAction = 'Suppr_Menu'
' End With
End Sub
Sub Suppr_SousMenu()
nomBarre = 'Worksheet menu bar'
Set NewMenu = Application.CommandBars(nomBarre).Controls('Macros')
NewMenu.Controls('Divers').Delete
End Sub
Sub Suppr_Menu()
nomBarre = 'Worksheet menu bar'
Set NewMenu = Application.CommandBars(nomBarre).Controls('Classement')
NewMenu.Delete
End Sub
'à mettre dans code thisworkbook
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Suppr_Menu
End Sub
Private Sub Workbook_Open()
Creer_Menu
End Sub
à bientôt