Bonjour,
Voici les codes de Zon, si cela peut t'aider :
à placer dans ThisWorbook
Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
MenuDestruction
End Sub
Private Sub Workbook_Open()
MenuC
End Sub
Dans un Module (nommé par Zon, MenuZon)
Option Explicit
Option Private Module
Const NomMenu = '&MonApplication' 'Le & permet de souligner la lettre située derriére ex:M
Const Menu1$ = 'M&onMenu1'
Const Menu2$ = '&A propos'
Const Menu3$ = '&Quitter '
Sub MenuC()
Dim Menu As CommandBarPopup, MenuItem As CommandBarControl
Dim TNom, TFaceId, I As Byte
On Error Resume Next
MenuDestruction
TNom = Array(Menu1, Menu2, Menu3) 'à adapter
TFaceId = Array(23, 49, 330) ' à adpater Les icones
Set Menu = CommandBars(1).Controls.Add(10, , , , True)
Menu.Caption = NomMenu
For I = LBound(TNom) To UBound(TNom)
Set MenuItem = Menu.Controls.Add(1)
With MenuItem
.Caption = TNom(I)
.FaceId = TFaceId(I)
.OnAction = 'Macro' & I + 1
End With
Next I
End Sub
'Les macros qu'on associe au différents boutons,Ici 3 la 4 eme s'appellera Macro4 .....
Sub Macro1()
MsgBox 'Ce n'est qu'une démo'
End Sub
Sub Macro2()
AideUSF.Show
End Sub
Sub Macro3()
MenuDestruction
ThisWorkbook.Close
End Sub
Sub MenuDestruction()
On Error Resume Next
CommandBars(1).Controls(NomMenu).Delete
End Sub
Un Usf fait pour l'occasion un code à placer :
Option Explicit
Private Sub UserForm_Initialize()
Me.Caption = 'Démo XLD'
End Sub
Ce menu avait déjà été fait pour :
Lien supprimé
Récupérer FaceID dans la zone de téléchargement
Et si j'ai rien oublié,, tu fais un copier coller de tout cela et cela doit fonctionner, un petit menu nommé Monapplication apparaîtra en haut de ta barre de menu (Zon n'a pas voulu nous mettre sa photo!!!!
).
Si problème, on t'envoie le menu!!! par email à ta demande.
Celeda