Ajouter un menu dans excel
cs_bob10
Messages postés
96
Date d'inscription
mercredi 2 juillet 2003
Statut
Membre
Dernière intervention
28 janvier 2009
-
20 sept. 2005 à 15:10
jpleroisse Messages postés 1788 Date d'inscription mardi 7 novembre 2000 Statut Membre Dernière intervention 11 mars 2006 - 23 sept. 2005 à 15:14
jpleroisse Messages postés 1788 Date d'inscription mardi 7 novembre 2000 Statut Membre Dernière intervention 11 mars 2006 - 23 sept. 2005 à 15:14
A voir également:
- Ajouter un menu dans excel
- Arctan excel - Forum VBA Office (Excel, Word ...)
- Les fonctions " racines niemmes " et " arctan "et "arccos " et "arcsin" - Forum Visual Basic
- Creer un formulaire pdf depuis excel - Forum VB.NET
- Tangente et arctangente ✓ - Forum C++ & C++ .NET
- Comment ajouter une zone de texte sur canva ✓ - Forum Delphi / Pascal
2 réponses
jpleroisse
Messages postés
1788
Date d'inscription
mardi 7 novembre 2000
Statut
Membre
Dernière intervention
11 mars 2006
27
20 sept. 2005 à 16:50
20 sept. 2005 à 16:50
Bonjour,
Tu lances la macro SousMenu.
Sub SousMenu()
Dim VewMenu As CommandBarPopup
Dim NewMenuItem As CommandBarButton
' supprimer le sous menu s'il existe déjà
Call DeleMenuItem
'Trouver le menu Affichage
Set VewMenu = CommandBars(1).FindControl(Id:=30004)
If VewMenu Is Nothing Then
MsgBox "Impossible d'ajouter l'élément de menu."
Exit Sub
Else
Set NewMenuItem = VewMenu.Controls.Add _
(Type:=msoControlButton)
With NewMenuItem
.Caption = "&Quadrillage"
.OnAction = "MaMacro"
End With
End If
End Sub
Sub DeleMenuItem()
On Error Resume Next
CommandBars(1).FindControl(Id:=30004). _
Controls("&Quadrillage").Delete
End Sub
Sub MaMacro()
If Range("A1").Value >= 1000 Then
ActiveWindow.DisplayGridlines = False
Else
ActiveWindow.DisplayGridlines = True
End If
End Sub
Pour supprimer le sous menu en quittant.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DeleMenuItem
End Sub
jpleroisse
Si une réponse te conviens, clique Réponse Acceptée
Tu lances la macro SousMenu.
Sub SousMenu()
Dim VewMenu As CommandBarPopup
Dim NewMenuItem As CommandBarButton
' supprimer le sous menu s'il existe déjà
Call DeleMenuItem
'Trouver le menu Affichage
Set VewMenu = CommandBars(1).FindControl(Id:=30004)
If VewMenu Is Nothing Then
MsgBox "Impossible d'ajouter l'élément de menu."
Exit Sub
Else
Set NewMenuItem = VewMenu.Controls.Add _
(Type:=msoControlButton)
With NewMenuItem
.Caption = "&Quadrillage"
.OnAction = "MaMacro"
End With
End If
End Sub
Sub DeleMenuItem()
On Error Resume Next
CommandBars(1).FindControl(Id:=30004). _
Controls("&Quadrillage").Delete
End Sub
Sub MaMacro()
If Range("A1").Value >= 1000 Then
ActiveWindow.DisplayGridlines = False
Else
ActiveWindow.DisplayGridlines = True
End If
End Sub
Pour supprimer le sous menu en quittant.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DeleMenuItem
End Sub
jpleroisse
Si une réponse te conviens, clique Réponse Acceptée
jpleroisse
Messages postés
1788
Date d'inscription
mardi 7 novembre 2000
Statut
Membre
Dernière intervention
11 mars 2006
27
23 sept. 2005 à 15:14
23 sept. 2005 à 15:14
Bonjour,
J'avais mal compris ta demande, le code que je t'ai mis crée un sous menu dans Affichage. Voici un code pour créer un nouveau menu et des sous-menus.
Sub AjouterNouveauMenu()
Dim HelpIndex As Integer
Dim NewMenu As CommandBarPopup
Dim MenuItem As CommandBarControl
'Supprimer le menu s'il existe déjà
Call DeleteMenu
'Obtenir l'index du menu Fichier
HelpIndex = CommandBars(1).Controls("Fichier").Index
'Créer le menu
Set NewMenu = CommandBars(1).Controls.Add _
(Type:=msoControlPopup, _
Before:=HelpIndex, Temporary:=True)
'Ajouter une légende
NewMenu.Caption = "Mon menu"
'Premier élément de menu
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "&Imprimer"
.FaceId = 162
.OnAction = "Macro1"
End With
'Deuxième élément de menu
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "&Quitter"
.FaceId = 590
.OnAction = "Macro1"
End With
End Sub
Sub DeleteMenu()
On Error Resume Next
CommandBars(1).Controls("Mon menu").Delete
End Sub
Pour supprimer le sous menu en quittant.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DeleteMenu
End Sub
jpleroisse
Si une réponse te conviens, clique Réponse Acceptée
J'avais mal compris ta demande, le code que je t'ai mis crée un sous menu dans Affichage. Voici un code pour créer un nouveau menu et des sous-menus.
Sub AjouterNouveauMenu()
Dim HelpIndex As Integer
Dim NewMenu As CommandBarPopup
Dim MenuItem As CommandBarControl
'Supprimer le menu s'il existe déjà
Call DeleteMenu
'Obtenir l'index du menu Fichier
HelpIndex = CommandBars(1).Controls("Fichier").Index
'Créer le menu
Set NewMenu = CommandBars(1).Controls.Add _
(Type:=msoControlPopup, _
Before:=HelpIndex, Temporary:=True)
'Ajouter une légende
NewMenu.Caption = "Mon menu"
'Premier élément de menu
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "&Imprimer"
.FaceId = 162
.OnAction = "Macro1"
End With
'Deuxième élément de menu
Set MenuItem = NewMenu.Controls.Add _
(Type:=msoControlButton)
With MenuItem
.Caption = "&Quitter"
.FaceId = 590
.OnAction = "Macro1"
End With
End Sub
Sub DeleteMenu()
On Error Resume Next
CommandBars(1).Controls("Mon menu").Delete
End Sub
Pour supprimer le sous menu en quittant.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Call DeleteMenu
End Sub
jpleroisse
Si une réponse te conviens, clique Réponse Acceptée
