Have a shortcut key to command bar

[macnab]

Dim CmdBar as CommandBar

Set CmdBar = CommandBars.Add(Name:="Roster", Position:=msoBarPopup, Temporary:=False)With CmdBar
.Controls.Add Type:=msoControlButton
.Controls(1).Caption = "&Clear Completely"
.Controls(1).OnAction = "ClearCompletely"

.Controls.Add Type:=msoControlButton
...

Is there a way to set a keypress shortcut to display the menu? Even if it has the name "Menu" at the top of the menu. :yes

[Logit]

.
Here is an example to go by ...

In the ThisWorkbook Module, paste this :



Option Explicit


Private Sub Workbook_Open()
Application.OnKey "a", "mkemenu" 'makemenu is the name of the macro that will be run when the key "a" is pressed.
End Sub






Paste this into a Routine Module :



Option Explicit


Sub mkemenu()
MsgBox "Hi"
End Sub


The name of the macro can be anything you want, so long as the macro name and the reference to the name in ThisWorkbook is the same.

The key can be anything you want as well. Instead of using Application.OnKey "a" ... you could use any other letter.

To find out more, do a 'google search' for : VBA OnKey

[macnab]

Thanks.

[macnab]

Doesn't work with a userform without a lot of work. (I have 120 comboboxes created at runtime.) :( It is bad enough that the user must right-click on the form itself.

[Logit]

.
Not certain I completely understand.

[macnab]

The context menu is for use while filling in a userform. Onkey doesn't work in this case. And with runtime created controls on the form, unless I create a class, I cannot make them respond to KeyDown.

[Logit]

.
Here is a sample UserForm Menu. It display the menu constantly but hopefully it is something you can use :



Option Base 1
Option Explicit
Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private xOffset As Single
Private yOffset As Single


Private Sub DisplayPopUp(ByVal idx As Byte)
Application.CommandBars("PopUpCb" & idx).ShowPopup xPos(idx), yPos
End Sub


Private Sub Button_U1_Click()
Call Menus_CheckBox(True)
End Sub


Private Sub Menus_CheckBox(Coché As Boolean)
Dim Ctl As Control

For Each Ctl In Me.Controls
If Left(Ctl.Name, 8) = "CheckBox" Then Ctl.Value = Coché
Next Ctl
End Sub






Private Sub ComboBox1_Change()
With ComboBox1
If .ListIndex = 0 Then [a1] = "un machin"
If .ListIndex = 1 Then [a1] = "un bidule"
If .ListIndex = 2 Then [a1] = "une chouette"
End With
End Sub


Private Sub lbl1_Click()
Call lblStyle(2, "1000")
DisplayPopUp 1
End Sub


Private Sub lbl1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Call lblStyle(3, "1000")
Call lblStyle(0, "1000")
End Sub


Private Sub lbl2_Click()
Call lblStyle(2, "0100")
DisplayPopUp 2
End Sub


Private Sub lbl2_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Call lblStyle(3, "0100")
Call lblStyle(0, "0100")
End Sub


Private Sub lbl3_Click()
Call lblStyle(2, "0010")
DisplayPopUp 3
End Sub


Private Sub lbl3_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Call lblStyle(3, "0010")
Call lblStyle(0, "0010")
End Sub


Private Sub lbl4_Click()
Call lblStyle(2, "0001")
DisplayPopUp 4
End Sub


Private Sub lbl4_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
'Call lblStyle(3, "0001")
Call lblStyle(0, "0001")
End Sub


' 0-Flat / 1-Raised / 2-Sunken / 3-Etched
Sub lblStyle(look As Byte, Optional Info As String = "0000")
Dim i As Byte

For i = 1 To Len(Info)
If Mid(Info, i, 1) = 0 Then
Me.Controls("lbl" & i).Font.Bold = False
Me.Controls("lbl" & i).SpecialEffect = 0
Else
Me.Controls("lbl" & i).Font.Bold = True
Me.Controls("lbl" & i).SpecialEffect = look
End If
Next i
End Sub


Sub CreatePopUp(ByVal idx As Integer)
' CbPopUp() = niveaux d'imbrication
Dim cb As CommandBar, CbPopup(2) As CommandBarPopup, noMenu As String

Call DeletePopUp("PopUpCb" & idx)
noMenu = "'MacroName""" & idx
Set cb = CommandBars.Add("PopUpCb" & idx, msoBarPopup, False, True)
Select Case idx
Case 1
Call AddItemInMenu(cb, Range("a1").Value, 212, noMenu & "01""'")
Call AddItemInMenu(cb, "&Sauvegarder", 3, noMenu & "02""'")
Call AddItemInMenu(cb, "&Quitter", 1, noMenu & "03""'", True)
Case 2
Call AddItemInMenu(cb, "&Nouvelle", 18, noMenu & "01""'")
Call AddItemInMenu(cb, "&Existante", 23, noMenu & "02""'")
Call AddItemInMenu(cb, "&Réceptions", 109, noMenu & "03""'")
Set CbPopup(1) = cb.Controls.Add(Type:=msoControlPopup, Temporary:=True)
CbPopup(1).Caption = "Ed&itions"
CbPopup(1).BeginGroup = True
Call AddItemInMenu(CbPopup(1), "Cdes à &relancer", 4, noMenu & "04""'")
Call AddItemInMenu(CbPopup(1), "Cdes non &soldées", 4, noMenu & "05""'")
Call AddItemInMenu(cb, "&Total Achats", 283, noMenu & "06""'", True)
Call AddItemInMenu(cb, "A&purement", 67, noMenu & "07""'")
Case 3
Set CbPopup(1) = cb.Controls.Add(Type:=msoControlPopup, Temporary:=True)
CbPopup(1).Caption = "A&rticles"
Call AddItemInMenu(CbPopup(1), "Fic&hes", 212, noMenu & "01""'")
Call AddItemInMenu(CbPopup(1), "&Utilisations", 140, noMenu & "02""'")
Call AddItemInMenu(CbPopup(1), "&Remplacement", 564, noMenu & "03""'")
Call AddItemInMenu(CbPopup(1), "&Liste des...", 4, noMenu & "04""'")
Call AddItemInMenu(CbPopup(1), "Calcul des c&oûts", 283, noMenu & "05""'")
Set CbPopup(2) = CbPopup(1).Controls.Add(Type:=msoControlPopup, Temporary:=True)
CbPopup(2).Caption = "Fa&milles"
CbPopup(2).BeginGroup = True
Call AddItemInMenu(CbPopup(2), "&Fiches", 212, noMenu & "06""'")
Call AddItemInMenu(CbPopup(2), "Li&ste des...", 4, noMenu & "07""'")
Set CbPopup(1) = cb.Controls.Add(Type:=msoControlPopup, Temporary:=True)
CbPopup(1).Caption = "&Fournisseurs"
Call AddItemInMenu(CbPopup(1), "Fic&hes", 212, noMenu & "08""'")
Call AddItemInMenu(CbPopup(1), "Liste &des...", 4, noMenu & "09""'")
Call AddItemInMenu(CbPopup(1), "&Qualité...", 4, noMenu & "10""'")
Set CbPopup(1) = cb.Controls.Add(Type:=msoControlPopup, Temporary:=True)
CbPopup(1).Caption = "Four&nitures"
Call AddItemInMenu(CbPopup(1), "F&iches", 212, noMenu & "11""'")
Call AddItemInMenu(CbPopup(1), "Lis&te des...", 4, noMenu & "12""'")
Set CbPopup(1) = cb.Controls.Add(Type:=msoControlPopup, Temporary:=True)
CbPopup(1).Caption = "&Nomenclatures"
Call AddItemInMenu(CbPopup(1), "Co&nsultation", 109, noMenu & "13""'")
Call AddItemInMenu(CbPopup(1), "&Modif / Création / Sup.", 212, noMenu & "14""'")
Call AddItemInMenu(CbPopup(1), "&Historique modifs", 172, noMenu & "15""'")
Call AddItemInMenu(CbPopup(1), "&Import CAO", 524, noMenu & "16""'")
Call AddItemInMenu(CbPopup(1), "&Export CAO", 525, noMenu & "17""'")
Set CbPopup(2) = CbPopup(1).Controls.Add(Type:=msoControlPopup, Temporary:=True)
CbPopup(2).Caption = "Editi&ons"
CbPopup(2).BeginGroup = True
Call AddItemInMenu(CbPopup(2), "&Quantifiée", 4, noMenu & "18""'")
Call AddItemInMenu(CbPopup(2), "Cumu&lée", 4, noMenu & "19""'")
Call AddItemInMenu(CbPopup(2), "Arbore&scente", 4, noMenu & "20""'")
Call AddItemInMenu(CbPopup(2), "&Liste des...", 4, noMenu & "21""'")
Set CbPopup(1) = cb.Controls.Add(Type:=msoControlPopup, Temporary:=True)
CbPopup(1).Caption = "&Données"
Call AddItemInMenu(CbPopup(1), "Cours des de&vises", 283, noMenu & "22""'")
Call AddItemInMenu(CbPopup(1), "&Imputations comptables", 195, noMenu & "23""'")
Call AddItemInMenu(CbPopup(1), "Im&putations analytiques", 303, noMenu & "24""'")
Call AddItemInMenu(CbPopup(1), "&Unités de mesure", 548, noMenu & "25""'")
Call AddItemInMenu(CbPopup(1), "&Conditions paiement", 384, noMenu & "26""'")
Call AddItemInMenu(CbPopup(1), "Coe&ff. Prix vente", 50, noMenu & "27""'")
Set CbPopup(1) = cb.Controls.Add(Type:=msoControlPopup, Temporary:=True)
CbPopup(1).Caption = "Stoc&ks"
Call AddItemInMenu(CbPopup(1), "&Entrées / Sorties", 212, noMenu & "28""'")
Call AddItemInMenu(CbPopup(1), "&Historique Trs", 172, noMenu & "29""'")
Case 4
Call AddItemInMenu(cb, "A&ide", 983, noMenu & "01""'")
Call AddItemInMenu(cb, "A pr&opos", 487, noMenu & "02""'")
End Select
Set CbPopup(1) = Nothing: Set CbPopup(2) = Nothing: Set cb = Nothing
End Sub

Private Function xPos(ByVal nb As Byte) As Single
xPos = (Me.Left + xOffset + Me.Controls("lbl" & nb).Left) * 4 / 3
End Function


Private Function yPos() As Single
yPos = (Me.Top + yOffset) * 4 / 3
End Function


Private Sub AddItemInMenu(CbControl As Object, TitleCaption As String, NoFaceId As Integer, WhenAction As String, Optional NewGroup As Boolean = False)
With CbControl.Controls.Add(msoControlButton, 1, , , True)
.BeginGroup = NewGroup
.Caption = TitleCaption
.Style = msoButtonIconAndCaption
.FaceId = NoFaceId
.OnAction = ThisWorkbook.Name & "!" & WhenAction & ""
End With
End Sub


Private Sub DeletePopUp(ByVal PopUpCbName As String)
On Error Resume Next
CommandBars(PopUpCbName).Delete
End Sub


Private Sub UserForm_Activate()
ComboBox1.AddItem "machin"
ComboBox1.AddItem "bidule"
ComboBox1.AddItem "chouette"




End Sub


Private Sub UserForm_Initialize()
Const pLbl As Byte = 3 ' Top des labels Menus
Const hLbl As Byte = 14 ' Hauteur des labels Menus
Dim i As Byte

For i = 1 To 4
Me.Controls("lbl" & i).Height = hLbl
Me.Controls("lbl" & i).Top = pLbl
Call CreatePopUp(i)
Next i
xOffset = (Me.Width - Me.InsideWidth) / 2
yOffset = Me.Height - Me.InsideHeight - xOffset + hLbl + pLbl
End Sub


Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
Call lblStyle(0, "0000")
End Sub

[macnab]

Something to look at.

[sathishsusa]

Dear Logit,

Your Menu is Awesome its very useful shall i get in English version of the menu list.

[Logit]

.
I don't have a translated version. If you go to Google and select the TRANSLATION option, you can translate the words there.

Hope that helps.

[sathishsusa]

Thank Logit :bow: