Excel VBA - ajouter un menu

Recherche :

Mot : Pseudo : Filtrer
Bas de page
Auteur	Sujet : Excel VBA - ajouter un menu

scaryfan

Apple Inside

:hello:

Décidément, la programmation VBA n'est pas si simple que ça sous Excel...
Je souhaite rajouter un menu personnalisé tout à droite du "?" de la barre de menu standard (Fichier Edition Affichage ... Fenêtre ?).

J'ai fait ce code pour rajouter le menu "TEST".

Code :

Dim NMenu As Object
Set NMenu = Application.CommandBars.Add ("TEST", msoBarRight, True, True)
With NMenu.Controls.Add(msoControlButton)
.Caption = "Test1"
.OnAction = "ATest1"
End With

J'ai inséré ce code au Sub Workbook_Open et à l'ouverture de mon fichier Excel, il n'y a pas de bug... mais rien ne s'affiche... :fou:

Merci pour votre aide...

:hello:

---------------
iMac 4Ghz (fin 2015) RAM 16Go SSD 256Go SSD 2To

Publicité

Xxxaaavvv

alors de mémoire

l'objet command bar tu ne doit pas l'ajouter, mais utiliser celui qui est déjà en place.

la tu fais de la programmation VB avancée

bon voici un module que je m'étais refait y a pas longtemps :

Code :

Option Explicit
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
' Projet : Outil Portable
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Fichier : modMenus
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Création : 09/02/2008
' Version : 1.0
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Description : Gestion des Menus d'Excel
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
' Procédure : fg_ChargementMenu
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Création : 09/02/2008
' Auteur : Xavier Ferrer
' Version : 1.0
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Entrée : strCommandBarName -> nom de la Barre contenant les menus
' : strMenuName -> nom du menu à ajouter
' Sortie : booléen 'True' si succès, 'False' sinon
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Description : Ajoute un menu directement à la barre de commande concernée
' : "Worksheet Menu Bar" représente la barre de menu des feuilles Excel (= strCommandBarName)
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Public Function fg_ChargementMenu(strCommandBarName As String, strMenuName As String) As Boolean
On Error GoTo fg_ChargementMenu_Error
Dim objMenu As CommandBar
Dim objPopup As CommandBarPopup
Dim blnPopupPresent As Boolean
fg_ChargementMenu = False
'On parcours les barres de menu
For Each objMenu In Application.CommandBars
If objMenu.Name = strCommandBarName Then
'On teste si le menu racine est déjà présent dans la barre
For Each objPopup In objMenu.Controls
If objPopup.Caption = strMenuName Then
blnPopupPresent = True
End If
Next objPopup
'S'il n'est pas présent on le rajoute
If Not blnPopupPresent Then
Set objPopup = objMenu.Controls.Add(msoControlPopup, , , 10, True)
objPopup.Caption = strMenuName
End If
End If
Next objMenu
Exit Function
fg_ChargementMenu_Error:
End Function
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
' Procédure : fg_ChargementSousMenu
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Création : 09/02/2008
' Version : 1.0
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Entrée : strCommandBarName -> nom de la Barre contenant les menus
' : strMenuName -> nom du menu impacter
' : strSousMenuCaption -> caption du sous-menu à ajouter
' : strSousMenuOnAction -> procédure à lancer quand le sous-menu est cliqué
' Sortie : booléen 'True' si succès, 'False' sinon
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Description : Ajoute un sous-menu directement dessous le menu de la barre de commande concernée
' : Par exemple "Worksheet Menu Bar" représente la barre de menu des feuilles Excel (= strCommandBarName)
' : suffit ensuite de prendre n'importe quel menu existant et de lui ajouter un sous-menu...
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Public Function fg_ChargementSousMenu(strCommandBarName As String, strMenuName As String, strSousMenuCaption As String, strSousMenuOnAction As String) As Boolean
On Error GoTo fg_ChargementSousMenu_Error
Dim objMenu As CommandBar
Dim objPopup As CommandBarPopup
Dim objButton As CommandBarButton
fg_ChargementSousMenu = False
'On parcours les barres de menu
For Each objMenu In Application.CommandBars
If objMenu.Name = strCommandBarName Then
'On parcours les menus de la barre
For Each objPopup In objMenu.Controls
If objPopup.Caption = strMenuName Then
'On ajoute le bouton de sous-menu
Set objButton = objPopup.Controls.Add(Type:=msoControlButton)
objButton.Caption = strSousMenuCaption
objButton.OnAction = strSousMenuOnAction
fg_ChargementSousMenu = True
End If
Next objPopup
End If
Next objMenu
Exit Function
fg_ChargementSousMenu_Error:
End Function
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
' Procédure : fg_DechargementSousMenu
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Création : 09/02/2008
' Version : 1.0
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Entrée : strCommandBarName -> nom de la Barre contenant les menus
' : strMenuName -> nom du menu impacter
' : strSousMenuCaption -> caption du sous-menu à supprimer
' Sortie : booléen 'True' si succès, 'False' sinon
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Description : Supprime un sous-menu du menu de la barre de commande concernée
' : "Worksheet Menu Bar" représente la barre de menu des feuilles Excel (= strCommandBarName)
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Public Function fg_DechargementSousMenu(strCommandBarName As String, strMenuName As String, strSousMenuCaption As String) As Boolean
On Error GoTo fg_DechargementSousMenu_Error
Dim objMenu As CommandBar
Dim objPopup As CommandBarPopup
Dim objButton As CommandBarButton
fg_DechargementSousMenu = False
'On parcours les barres de menu
For Each objMenu In Application.CommandBars
If objMenu.Name = strCommandBarName Then
'On parcours les menus de la barre
For Each objPopup In objMenu.Controls
If objPopup.Caption = strMenuName Then
'On parcours les sous-menu
For Each objButton In objPopup.Controls
If objButton.Caption = strSousMenuCaption Then
'On supprime le bouton de menu
objButton.Delete
fg_DechargementSousMenu = True
End If
Next objButton
End If
Next objPopup
End If
Next objMenu
Exit Function
fg_DechargementSousMenu_Error:
End Function
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
' Procédure : fg_SousMenuPresent
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Création : 09/02/2008
' Version : 1.0
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Entrée : strCommandBarName -> nom de la Barre contenant les menus
' : strMenuName -> nom du menu impacter
' : strSousMenuCaption -> caption du sous-menu à tester
' Sortie : booléen 'True' si succès, 'False' sinon
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Description : Teste la présence d'un sous menu dans excel
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Public Function fg_SousMenuPresent(strCommandBarName As String, strMenuName As String, strSousMenuCaption As String) As Boolean
On Error GoTo fg_SousMenuPresent_Error
Dim objMenu As CommandBar
Dim objPopup As CommandBarPopup
Dim objButton As CommandBarButton
fg_SousMenuPresent = False
'On parcours les barres de menu
For Each objMenu In Application.CommandBars
If objMenu.Name = strCommandBarName Then
'On parcours les menus de la barre
For Each objPopup In objMenu.Controls
If objPopup.Caption = strMenuName Then
'On parcours les sous-menu
For Each objButton In objPopup.Controls
If objButton.Caption = strSousMenuCaption Then
'Le menu est présent
fg_SousMenuPresent = True
End If
Next objButton
End If
Next objPopup
End If
Next objMenu
Exit Function
fg_SousMenuPresent_Error:
End Function

et voici ce que j'avais dans mon workbook_open :

Code :

Private Sub Workbook_Open()
On Error GoTo Workbook_Open_Error
Const strCommandBarName As String = "Worksheet Menu Bar"
Const strMenuPNCaption As String = "Outils &PN"
Call fg_ChargementMenu(strCommandBarName, strMenuPNCaption)
Call fg_ChargementSousMenu(strCommandBarName, strMenuPNCaption, "&Supprimer les lignes barrées", "modOutilsVBA.subMenuSuppressionLignes" )
'Call fg_ChargementSousMenu(strCommandBarName, strMenuPNCaption, "&Options", "modMain.subMenuOptions" )
'Call fg_ChargementSousMenu(strCommandBarName, strMenuPNCaption, "&Test", "modOutilsVBA.subMenuTest" )
Exit Sub
Workbook_Open_Error:
End Sub

je te laisse adapter ça tout seul comme un grand

Message cité 1 fois
Message édité par Xxxaaavvv le 06-06-2008 à 17:21:25

scaryfan

Apple Inside

Xxxaaavvv a écrit :

Code :

Option Explicit
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
' Projet : Outil Portable
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Fichier : modMenus
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Création : 09/02/2008
' Auteur : Xxxaaavvv
' Version : 1.0
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Description : Gestion des Menus d'Excel
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
' Procédure : fg_ChargementMenu
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Création : 09/02/2008
' Auteur : Xxxaaavvv
' Version : 1.0
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Entrée : strCommandBarName -> nom de la Barre contenant les menus
' : strMenuName -> nom du menu à ajouter
' Sortie : booléen 'True' si succès, 'False' sinon
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Description : Ajoute un menu directement à la barre de commande concernée
' : "Worksheet Menu Bar" représente la barre de menu des feuilles Excel (= strCommandBarName)
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Public Function fg_ChargementMenu(strCommandBarName As String, strMenuName As String) As Boolean
On Error GoTo fg_ChargementMenu_Error
Dim objMenu As CommandBar
Dim objPopup As CommandBarPopup
Dim blnPopupPresent As Boolean
fg_ChargementMenu = False
'On parcours les barres de menu
For Each objMenu In Application.CommandBars
If objMenu.Name = strCommandBarName Then
'On teste si le menu racine est déjà présent dans la barre
For Each objPopup In objMenu.Controls
If objPopup.Caption = strMenuName Then
blnPopupPresent = True
End If
Next objPopup
'S'il n'est pas présent on le rajoute
If Not blnPopupPresent Then
Set objPopup = objMenu.Controls.Add(msoControlPopup, , , 10, True)
objPopup.Caption = strMenuName
End If
End If
Next objMenu
Exit Function
fg_ChargementMenu_Error:
End Function
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
' Procédure : fg_ChargementSousMenu
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Création : 09/02/2008
' Auteur : Xxxaaavvv
' Version : 1.0
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Entrée : strCommandBarName -> nom de la Barre contenant les menus
' : strMenuName -> nom du menu impacter
' : strSousMenuCaption -> caption du sous-menu à ajouter
' : strSousMenuOnAction -> procédure à lancer quand le sous-menu est cliqué
' Sortie : booléen 'True' si succès, 'False' sinon
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Description : Ajoute un sous-menu directement dessous le menu de la barre de commande concernée
' : Par exemple "Worksheet Menu Bar" représente la barre de menu des feuilles Excel (= strCommandBarName)
' : suffit ensuite de prendre n'importe quel menu existant et de lui ajouter un sous-menu...
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Public Function fg_ChargementSousMenu(strCommandBarName As String, strMenuName As String, strSousMenuCaption As String, strSousMenuOnAction As String) As Boolean
On Error GoTo fg_ChargementSousMenu_Error
Dim objMenu As CommandBar
Dim objPopup As CommandBarPopup
Dim objButton As CommandBarButton
fg_ChargementSousMenu = False
'On parcours les barres de menu
For Each objMenu In Application.CommandBars
If objMenu.Name = strCommandBarName Then
'On parcours les menus de la barre
For Each objPopup In objMenu.Controls
If objPopup.Caption = strMenuName Then
'On ajoute le bouton de sous-menu
Set objButton = objPopup.Controls.Add(Type:=msoControlButton)
objButton.Caption = strSousMenuCaption
objButton.OnAction = strSousMenuOnAction
fg_ChargementSousMenu = True
End If
Next objPopup
End If
Next objMenu
Exit Function
fg_ChargementSousMenu_Error:
End Function
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
' Procédure : fg_DechargementSousMenu
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Création : 09/02/2008
' Auteur : Xxxaaavvv
' Version : 1.0
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Entrée : strCommandBarName -> nom de la Barre contenant les menus
' : strMenuName -> nom du menu impacter
' : strSousMenuCaption -> caption du sous-menu à supprimer
' Sortie : booléen 'True' si succès, 'False' sinon
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Description : Supprime un sous-menu du menu de la barre de commande concernée
' : "Worksheet Menu Bar" représente la barre de menu des feuilles Excel (= strCommandBarName)
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Public Function fg_DechargementSousMenu(strCommandBarName As String, strMenuName As String, strSousMenuCaption As String) As Boolean
On Error GoTo fg_DechargementSousMenu_Error
Dim objMenu As CommandBar
Dim objPopup As CommandBarPopup
Dim objButton As CommandBarButton
fg_DechargementSousMenu = False
'On parcours les barres de menu
For Each objMenu In Application.CommandBars
If objMenu.Name = strCommandBarName Then
'On parcours les menus de la barre
For Each objPopup In objMenu.Controls
If objPopup.Caption = strMenuName Then
'On parcours les sous-menu
For Each objButton In objPopup.Controls
If objButton.Caption = strSousMenuCaption Then
'On supprime le bouton de menu
objButton.Delete
fg_DechargementSousMenu = True
End If
Next objButton
End If
Next objPopup
End If
Next objMenu
Exit Function
fg_DechargementSousMenu_Error:
End Function
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
' Procédure : fg_SousMenuPresent
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Création : 09/02/2008
' Auteur : Xxxaaavvv
' Version : 1.0
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Entrée : strCommandBarName -> nom de la Barre contenant les menus
' : strMenuName -> nom du menu impacter
' : strSousMenuCaption -> caption du sous-menu à tester
' Sortie : booléen 'True' si succès, 'False' sinon
' - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Description : Teste la présence d'un sous menu dans excel
' = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
Public Function fg_SousMenuPresent(strCommandBarName As String, strMenuName As String, strSousMenuCaption As String) As Boolean
On Error GoTo fg_SousMenuPresent_Error
Dim objMenu As CommandBar
Dim objPopup As CommandBarPopup
Dim objButton As CommandBarButton
fg_SousMenuPresent = False
'On parcours les barres de menu
For Each objMenu In Application.CommandBars
If objMenu.Name = strCommandBarName Then
'On parcours les menus de la barre
For Each objPopup In objMenu.Controls
If objPopup.Caption = strMenuName Then
'On parcours les sous-menu
For Each objButton In objPopup.Controls
If objButton.Caption = strSousMenuCaption Then
'Le menu est présent
fg_SousMenuPresent = True
End If
Next objButton
End If
Next objPopup
End If
Next objMenu
Exit Function
fg_SousMenuPresent_Error:
End Function

et voici ce que j'avais dans mon workbook_open :

Code :

Private Sub Workbook_Open()
On Error GoTo Workbook_Open_Error
Const strCommandBarName As String = "Worksheet Menu Bar"
Const strMenuPNCaption As String = "Outils &PN"
Call fg_ChargementMenu(strCommandBarName, strMenuPNCaption)
Call fg_ChargementSousMenu(strCommandBarName, strMenuPNCaption, "&Supprimer les lignes barrées", "modOutilsVBA.subMenuSuppressionLignes" )
'Call fg_ChargementSousMenu(strCommandBarName, strMenuPNCaption, "&Options", "modMain.subMenuOptions" )
'Call fg_ChargementSousMenu(strCommandBarName, strMenuPNCaption, "&Test", "modOutilsVBA.subMenuTest" )
Exit Sub
Workbook_Open_Error:
End Sub

je te laisse adapter ça tout seul comme un grand :D

L'est gentil le petit Xxxaaavvv

Je vais tenter déjà de rajouter tout cela dans mon code...

Et effectivement, c'est déjà de la programmation avancée... :pt1cable:

---------------
iMac 4Ghz (fin 2015) RAM 16Go SSD 256Go SSD 2To

scaryfan

Apple Inside

:hello:

J'ai une question concernant le code que l'on insère dans le WorkBook_Open :

Code :

'Call fg_ChargementSousMenu(strCommandBarName, strMenuPNCaption, "&Options", "modMain.subMenuOptions" )

La macro appelée s'appelle modMain.subMenuOptions... mais je n'arrive pas à lancer la macro...
Impossible de trouver la macro...

Pourtant j'ai créé un sub macro()

Xxxaaavvv

modMain.subMenuOptions

modMain = nom du module ou se trouve ta macro
subMenuOptions = nom de ta macro

si tu a créer :
sub macro()
alors ça doit être un truc du style :

module.macro

a toi de jouer.

scaryfan

Apple Inside

Merci Xxxaaavvv !
Tout fonctionne correctement à présent...

---------------
iMac 4Ghz (fin 2015) RAM 16Go SSD 256Go SSD 2To

FORUM HardWare.fr

Programmation

VB/VBA/VBS

Excel VBA - ajouter un menu

Sujets relatifs
menu bloqué sous IE mais ok sous Firefox...	SQL Server : boucle sur une table et affichage
excel macro combobox	masquage erreur #valeur sous VBA Excel
Integrer un menu deroulant en flash dans une page HTML	[VBA] Petite Question sur les Array's
[Résolu][XLS] Raffraichissement d'1 cellule utilisant une fonction VBA	Editer des cellules d'une listbox en VBA
problème macro excel
Plus de sujets relatifs à : Excel VBA - ajouter un menu

Page générée en 0.185 secondes