Menu personalisé et macros associés
Bonsoir,
je souhaitais créer un menu adapté à mon utlisation, qui se chargerait à l'ouverture spécifique d'un fichier.
J'ai trouvé un exemple quasi similaire, que j'ai commencé à adapter
A)Module
Option Explicit
Public Sub CreerMenu()
Dim Barre As CommandBar
Dim Menu As CommandBarPopup
Dim Btn As CommandBarButton
SupprimerMenu
Set Barre = Application.CommandBars("Worksheet Menu Bar")
With Barre
Set Menu = .Controls.Add(msoControlPopup)
With Menu
.Caption = "Aide Bilan thermique"
Set Btn = .Controls.Add(msoControlButton)
With Btn
.Caption = "Aide sur bilan thermique"
.OnAction = "Aide"
.Parameter = "General"
.Visible = True
End With
Set Btn = .Controls.Add(msoControlButton)
With Btn
.Caption = "Aide sur cette feuille"
.OnAction = "Aide"
.Parameter = "Feuille"
.Visible = True
End With
End With
End With
Set Barre = Application.CommandBars("Chart Menu Bar")
With Barre
Set Menu = .Controls.Add(msoControlPopup)
With Menu
.Caption = "Aide Bilan thermique"
Set Btn = .Controls.Add(msoControlButton)
With Btn
.Caption = "Aide sur bilan thermique"
.OnAction = "Aide"
.Parameter = "General"
.Visible = True
End With
Set Btn = .Controls.Add(msoControlButton)
With Btn
.Caption = "Aide sur cette feuille"
.OnAction = "Aide"
.Parameter = "Feuille"
.Visible = True
End With
End With
End With
Set Barre = Nothing
Set Menu = Nothing
Set Btn = Nothing
End Sub
Sub SupprimerMenu()
On Error Resume Next
Application.CommandBars("Chart Menu Bar").Controls("Aide Bilan thermique").Delete
Application.CommandBars("Worksheet Menu Bar").Controls("Aide Bilan thermique").Delete
On Error GoTo 0
End Sub
Sub CacherAfficher(Afficher As Boolean)
On Error Resume Next
Application.CommandBars("Chart Menu Bar").Controls("Aide Bilan thermique").Visible = Afficher
Application.CommandBars("Worksheet Menu Bar").Controls("Aide Bilan thermique").Visible = Afficher
On Error GoTo 0
End Sub
Sub SurfaceRectangle()
Dim a As Variant
Dim b As Variant
a = InputBox("Longueur")
b = InputBox("largeur")
MsgBox ("surface" & a * b)
End Sub
Sub SurfaceCercle()
Dim R As Variant
R = InputBox("Longueur")
MsgBox ("Surface du cercle = " & 3.14 * R*R)
End Sub
B)THISWORBOOK
Option Explicit
Private Sub Workbook_Open()
CreerMenu
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
SupprimerMenu
End Sub
Private Sub Workbook_Activate()
CacherAfficher True
End Sub
Private Sub Workbook_Deactivate()
CacherAfficher False
End Sub
je compte donc remplacer
le titre du menu
AIDE BILAN THERMIQUE par SURFACE
le nom des boutons
AIDE SUR BILAN THERMIQUE par RECTANGLE
AIDE SUR CETTE FEUILLE par CERCLE
Par contre je sais pas trop comment Lancer les macros en cliquant sur les boutons.
Je pourrais joindre le fichier en entier si besoin.
Merci
Salut ExcelNovice et le forum
Joue sur les paramètres
[color=red].Caption = "Aide sur bilan thermique"
.OnAction = "Aide"
Caption = le nom du bouton
OnAction = le nom de la macro
Mytå
Re le forum
Le principe de base est
Sub SupprimerCommande()
On Error Resume Next
Application.CommandBars("Edit").Controls("MonCopier").Delete
End Sub
Sub AjouterCommande()
Set Tools = Application.CommandBars("Edit")
With Tools.Controls.Add(, , , , True)
.BeginGroup = True 'Séparation avant le bouton de commande
.Caption = "MonCopier"
.OnAction = "Nom de la macro à exécuter"
End With
End SubMytå
Bonsoir,
j'ai modifié certains paramêtre du code ci joint pour adapter à mes besoins.
Je voudrais en fait tout simplement créer un menu personalisé uniquement sur un classeur donné.
Ce menu s'apellerait Calcul de surface, avec 2 boutons , surface rectangle et autre surface cercle qui lancerait les macros associées
https://www.excel-pratique.com/~files/doc/HBq61test.xls
Si une personne à le temps de me trouver une solution et de m'expliquer ce qui clochait
Re bonsoir,
j'ai reussi a lancer mes macros il fallait que je garde les guillemets en fait, je pensais que la macro aurait ét é considérée come du texte
Par contre je vois pas à quoi peux servir
Set Barre = Application.CommandBars("Chart Menu Bar")