créer automatiquement un menu spécifique en ouvrant un classeur

Bonjour,

exemple :
Function AjoutBarreMenu() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, MaBarre, MonItem As Object

On Error GoTo Err_Barre

Flag = SupprimeMenu
Flag = False

'Création de la barre de menu
Set BarreMenu = Application.CommandBars.ActiveMenuBar
Set MaBarre = BarreMenu.Controls.Add(Type:=msoControlPopup,
temporary:=True)

MaBarre.Caption = "Automatisme"

'Insère menu
Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Ouvrir sans VBA"
.OnAction = "OuvrirSansVBA"
.FaceId = 2579
End With

Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "VB Editeur"
.OnAction = "VBEditeur"
.FaceId = 66
End With

AjoutBarreMenu = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutBarreMenu = False
Texte = "Erreur dans la routine AjoutBarreMenu"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMenu() As Boolean

Dim Cmpt, Nombre As Integer
Dim Barre As CommandBarControl

Nombre = Application.CommandBars.ActiveMenuBar.Controls.Count
For Cmpt = 1 To Nombre
If
(Application.CommandBars.ActiveMenuBar.Controls.Item(Cmpt).Caption =
"Automatisme") Then
Application.CommandBars("Worksheet Menu
Bar").Controls("Automatisme").Delete
End If
Next Cmpt
SupprimeMenu = True

Exit_Close:
Exit Function

Err_Close:
MsgBox "Erreur dans la routine SupprimeMenu du classeur MenuPerso!"
MsgBox Err.Number & " - " & Err.Description
SupprimeMenu = False

End Function


Dans la routine WorkBook_Open

ajouter

Call SupprimeMenu
Call AjoutBarreMenu

et dans la routine Before_Close
Call SupprimeMenu

mousnynao

A l'ouverture d'un classeur, je souhaite créer un menu spécifique au
traitement de ce classeur, ce menu disparaissant à la fermeture de ce
classeur.

Merci des renseignements qui pourraient m'être fournis.

Bonsoir,

http://cjoint.com/?drvXkkusiV

Dans un module:

Sub auto_open()
'ajouter le menu Conversion avant le menu Outils
MenuBars(xlWorksheet).Menus.Add Caption:="&Conversion", Before:=6
'ajouter les commandes au menu Conversion
With MenuBars(xlWorksheet).Menus("Conversion").MenuItems
.Add Caption:="Ma&juscule", OnAction:="Majuscule"
.Add Caption:="Mi&nuscule", OnAction:="Minuscule"
.Add Caption:="&Nom Propre", OnAction:="NomPropre"
.Add Caption:="&Euros", OnAction:="ConversionEuros"
.Add Caption:="&Francs", OnAction:="ConversionFrancs"

End With
'ajouter une commande au menu Outils
MenuBars(xlWorksheet).Menus("Outils").MenuItems.Add
Caption:="Ma&juscule", OnAction:="Majuscule"
End Sub

Sub auto_close()
For Each M In MenuBars(xlWorksheet).Menus
If M.Caption = "&Conversion" Then M.Delete
Next
End Sub

Sub Majuscule()
For Each c In Selection
If Not IsNumeric(c.Value) And Not IsDate(c.Value) Then
c.Value = UCase(c.Value)
End If
Next c
End Sub

Cordialement JB

Merci JB : c'est un sérieux coup de main...

Bonsoir,

http://cjoint.com/?drvXkkusiV

Dans un module:

Sub auto_open()
'ajouter le menu Conversion avant le menu Outils
MenuBars(xlWorksheet).Menus.Add Caption:="&Conversion", Before:=6
'ajouter les commandes au menu Conversion
With MenuBars(xlWorksheet).Menus("Conversion").MenuItems
.Add Caption:="Ma&juscule", OnAction:="Majuscule"
.Add Caption:="Mi&nuscule", OnAction:="Minuscule"
.Add Caption:="&Nom Propre", OnAction:="NomPropre"
.Add Caption:="&Euros", OnAction:="ConversionEuros"
.Add Caption:="&Francs", OnAction:="ConversionFrancs"

End With
'ajouter une commande au menu Outils
MenuBars(xlWorksheet).Menus("Outils").MenuItems.Add
Caption:="Ma&juscule", OnAction:="Majuscule"
End Sub

Sub auto_close()
For Each M In MenuBars(xlWorksheet).Menus
If M.Caption = "&Conversion" Then M.Delete
Next
End Sub

Sub Majuscule()
For Each c In Selection
If Not IsNumeric(c.Value) And Not IsDate(c.Value) Then
c.Value = UCase(c.Value)
End If
Next c
End Sub

Cordialement JB

Merci Mousnynao, ça m'enlève une grosse épine du pied ...

Bonjour,

exemple :
Function AjoutBarreMenu() As Boolean
'
Dim Texte As String
Dim I As Integer
Dim Flag As Boolean
Dim BarreMenu, MaBarre, MonItem As Object

On Error GoTo Err_Barre

Flag = SupprimeMenu
Flag = False

'Création de la barre de menu
Set BarreMenu = Application.CommandBars.ActiveMenuBar
Set MaBarre = BarreMenu.Controls.Add(Type:=msoControlPopup,
temporary:=True)

MaBarre.Caption = "Automatisme"

'Insère menu
Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "Ouvrir sans VBA"
.OnAction = "OuvrirSansVBA"
.FaceId = 2579
End With

Set MonItem = MaBarre.Controls.Add(Type:=msoControlButton)
With MonItem
.Caption = "VB Editeur"
.OnAction = "VBEditeur"
.FaceId = 66
End With

AjoutBarreMenu = True

Exit_Barre:
Exit Function

Err_Barre:
AjoutBarreMenu = False
Texte = "Erreur dans la routine AjoutBarreMenu"
Texte = Texte & Chr(13) & Err.Number
Texte = Texte & Chr(13) & Err.Description
MsgBox Texte
Resume Next

End Function
'

Function SupprimeMenu() As Boolean

Dim Cmpt, Nombre As Integer
Dim Barre As CommandBarControl

Nombre = Application.CommandBars.ActiveMenuBar.Controls.Count
For Cmpt = 1 To Nombre
If
(Application.CommandBars.ActiveMenuBar.Controls.Item(Cmpt).Caption =
"Automatisme") Then
Application.CommandBars("Worksheet Menu
Bar").Controls("Automatisme").Delete
End If
Next Cmpt
SupprimeMenu = True

Exit_Close:
Exit Function

Err_Close:
MsgBox "Erreur dans la routine SupprimeMenu du classeur MenuPerso!"
MsgBox Err.Number & " - " & Err.Description
SupprimeMenu = False

End Function


Dans la routine WorkBook_Open

ajouter

Call SupprimeMenu
Call AjoutBarreMenu

et dans la routine Before_Close
Call SupprimeMenu

mousnynao

A l'ouverture d'un classeur, je souhaite créer un menu spécifique au
traitement de ce classeur, ce menu disparaissant à la fermeture de ce
classeur.

Merci des renseignements qui pourraient m'être fournis.