Sub Creation_barre_outil()
Application.ScreenUpdating = False
Toolbars.Add Name:="Outils NewGam"
Toolbars("Outils NewGam").Visible = True

Set BarOutil = Toolbars("Outils NewGam").ToolbarButtons
BarOutil.Add Button:=214, Before:=1, OnAction:="Action0",Enabled:=True,Pushed:=False
BarOutil(1).Name = "Interface"

Set BarOutil = Toolbars("Outils NewGam").ToolbarButtons
BarOutil.Add Button:=211, Before:=1, OnAction:="Action1", Enabled:=True,Pushed:=False
BarOutil(1).Name = "CréeTarifCatalogue"

Set BarOutil = Toolbars("Outils NewGam").ToolbarButtons
BarOutil.Add Button:=213, Before:=1, OnAction:="Action2", Enabled:=True, Pushed:=False
BarOutil(1).Name = "CreeTarifExport"

Set BarOutil = Nothing

'Positionnement de la barre d'outils

With Toolbars("Outils NewGam")
.Left = 620
.Top = 450
.Width = 120
End With
End Sub

'Execution des commandes

Sub Action0()
Range("a1").Formula = "Commande Action0"
End Sub

Sub Action1()
Range("a2").Formula = "Commande Action1"
End Sub

Sub Action2()
Range("a3").Formula = "Commande Action2"
End Sub

Sub SupprimeBarOutil()
On Error Resume Next
Toolbars("Outils NewGam").Delete
End Sub

Création d'une barre d'outils
Nouvelle version

Sub NewBar()
Application.CommandBars.Add(Name:="BarPerso").Visible = True
Application.CommandBars("BarPerso").Controls.Add Type:=msoControlButton, ID _
:=19, Before:=1
Application.CommandBars("BarPerso").Controls.Add Type:=msoControlButton, ID _
:=22, Before:=2
With CommandBars("BarPerso")
.Left = 620
.Top = 450
.Width = 120
End With
End Sub

Sub AjouteMenus()
MenuBars(xlWorksheet).Menus.Add Caption:="&MonMenu",before:=9

'(before:=9)modifié cette valeur pour placer le menu où vous voulez

MenuBars(xlWorksheet).Menus("&MonMenu").MenuItems.Add _
Caption:="&SousMenu1", before:=1, OnAction:="Nom de la macro 1"   

'Exécute la macro 1

MenuBars(xlWorksheet).Menus("&MonMenu").MenuItems.Add _
Caption:="&SousMenu2", before:=1, OnAction:="Nom de la macro 2"   

'Exécute la macro 2

End Sub

Sub SupprimeMenus()
For Each MenuName In MenuBars(xlWorksheet).Menus
If MenuName.Caption = "&MonMenu" Then
MenuName.Delete
End If
Next
End Sub

Création d'un menu contextuel (Click droit)

Sub CreationMenuContext()
With Application.CommandBars("Cell").Controls.Add(msoControlButton)
.Caption = "Avez-vous un chat?"
.BeginGroup = True
.OnAction = "Question"
End With
End Sub

Sub Question()
MsgBox ("Oui !")
End Sub

'Réinitialise le menu contextuel

Sub delMenuContext()
Application.CommandBars("Cell").Reset
End Sub

Ajoute une fonction au petit menu de la barre d'état.(en bas à droite)

Sub AfficheBoutons()
Dim NewBarreOutil As CommandBar
Dim NewBouton As CommandBarButton
Dim i As Integer, IconOn As Integer, IconOff As Integer

'Supprime la barre si elle existe déjà

On Error Resume Next
Application.CommandBars("BarBouton").Delete
On Error GoTo 0

Set NewBarreOutil = Application.CommandBars.Add _
(Name:="BarBouton", temporary:=True)
NewBarreOutil.Visible = True

'Affiche les boutons 1 à 200
Suivant la vitesse de votre ordinateur vous pouvez passer
le paramètre IconOff à 600 (Attente de 30 secondes)
Ou bien modifier le paramètre de départ IconOn = 100
et IconOff= 200 (Rapide)

IconOn = 1
IconOff = 200

For i = IconOn To IconOff
Set NewBouton = NewBarreOutil.Controls.Add _
(Type:=msoControlButton, ID:=2950)
NewBouton.FaceId = i
NewBouton.Caption = "FaceID = " & i
Next i
NewBarreOutil.Width = 700
NewBarreOutil.Left = 50
NewBarreOutil.Top = 120
End Sub

Comment supprimer la barre de menus principale ?

Sub SupMenuBar()
Application.CommandBars("Worksheet Menu Bar").Enabled = False
End Sub

Et pour l'afficher:
Application.CommandBars("Worksheet Menu Bar").Enabled = True

ou bien (xl97/XP)
Sub supBA()
For Each LaBarMenu In ActiveMenuBar.Menus
LaBarMenu.Delete
Next
MsgBox "Barre de menus supprimée !"
ActiveMenuBar.Reset
MsgBox "Barre de menus rétablie !"
End Sub

Affiche la barre de menus principale (Fichier Edition Affichage etc...)

Application.CommandBars(1).Enabled = True

Masque la barre de menus principale

Application.CommandBars(1).Enabled = False

Création d'un bouton dans la barre d'outils "Perso"

Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer Public Const VK_SHIFT = &H10

Sub Bt_AjoutFeuille()
On Error Resume Next
Set newBtn = Application.CommandBars("Perso").Controls.Add(Type:=msoControlButton, before:=1)
With newBtn
.Name = "Bouton Ajout de feuille"
.TooltipText = "Insère une nouvelle feuille"
.FaceId = 578
.OnAction = "AjoutFeuille"
.Visible = True
End With
End Sub

Code du bouton: Insertion de feuille dans le classeur

Sub AjoutFeuille()
Sheets.Add
If GetKeyState(VK_SHIFT) < 0 Then
ActiveSheet.Move After:=Worksheets(ActiveSheet.Index + 1)
Else
ActiveSheet.Move After:=Worksheets(Sheets.Count)
End If
End Sub

Annule la commande Edition Copier de la barre de menus

Position dans le menu Controls(2).Controls(4)

Sub EditionCopierNo()
Application.CommandBars(1).Controls(2).Controls(4).Enabled = False
End Sub

Rétablissement de la commande

Sub EditionCopierOK()
Application.CommandBars(1).Controls(2).Controls(4).Enabled = True
End Sub

Avec le nom du menu (Edit) et numéro ID (19)

Sub EditionCopierNo()
Application.CommandBars("Edit").FindControl(ID:=19).Enabled = False
End Sub

Rétablissement de la commande

Sub EditionCopierOK()
Application.CommandBars("Edit").FindControl(ID:=19).Enabled = True
End Sub

Annule la commande Outils Options de la barre de menus

Sub menuOutilsOptNo()
Application.CommandBars("Tools").FindControl(ID:=522).Enabled = False
End Sub

Rétabli la commande option du menu Outils

Sub menuOutilsOptok()
Application.CommandBars("Tools").FindControl(ID:=522).Enabled = True
End Sub

xlcommands.zip   20 ko  Liste de tous les numéros Id de la barre de menus

Liste le nom des barres d'outils

Affiche le nom et le nom local de chaque barre de menus
et de chaque barre d'outils en indiquant si elles sont visibles ou non.

Sub LstBO()
'Worksheets("LstBO").Select
For Each cbar In CommandBars
x = x + 1
[A1] = "Nom de la barre d'outils"
[A1].Offset(x, 0) = cbar.Name
[B1] = "Nom local de la barre d'outils"
[B1].Offset(x, 0) = cbar.NameLocal
[C1] = "Visible"
[C1].Offset(x, 0) = cbar.Visible
Next
End Sub