Excel 2003 Custom Menus-ShortcutText

[John]

I would like to display a shortcut key along with Excel's (2003) custom
menu, but can't figure out how to do it. Here's my sub to add my custom
menu:

Sub AddNewMenu()
Dim NewMenu As CommandBarControl
Dim NewItem As CommandBarControls
Dim HelpIndex As Integer
Dim Cap1, Cap2, Cap3, Cap4
Dim Mac1, Mac2, Mac3, Mac4

' Make sure the menus aren't duplicated
Call DeleteMenu

Cap1 = "&Insert Row, Copy Formula"
Cap2 = "&Delete Row on Database"
Cap3 = "&Add New Group"

' Get Index of Help Menu
HelpIndex = CommandBars(1).Controls("Help").Index

' Create the control
Set NewMenu = CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
before:=HelpIndex, Temporary:=True)
NewMenu.Caption = "Data&base menu"
NewMenu.BeginGroup = "True"

CommandBars(1).Controls("Help").BeginGroup = True

' Add Menu Item
Set NewItem = CommandBars(1). _
Controls("Database menu").Controls

With NewItem
.Add.Caption = Cap1
.Add.Caption = Cap2
.Add.Caption = Cap3
.Add.Caption = Cap4
End With

How can I add short cut text to this menu? For instance, with Cap1 above
("&Insert Row, Copy Formula") I'd like it to say Ctrl-I off to the right. .I
know it takes the ShortcutText property. Thank you

 

[JLGWhiz]

Add it in as part of the caption.'

Cap1 = "&Insert Row, Copy Formula Ctl + I"

 

[John]

Thanks, I tried that, but the text doesn't line up too well. Isn't this what
that ShortcutText property is for?

 

[Dave Peterson]

First, you have a typo on the declaration for NewItem. Drop the trailing S.

Second, instead of declaring 8 variables (cap1, ..., mac4), you could define a
couple of arrays and just loop through them. It should make the code a bit
easier to modify when (not if!!) you make changes:

Option Explicit
Const MyMenuName As String = "Data&base Menu"
Sub Autpen()
Call AddNewMenu
End Sub
Sub Auto_Close()
Call DeleteMenu
End Sub
Sub AddNewMenu()
Dim NewMenu As CommandBarControl
Dim NewItem As CommandBarControl '<-- drop the trailing S
Dim HelpIndex As Long
Dim Cap As Variant
Dim Mac As Variant
Dim ShrtCutKey As Variant
Dim iCtr As Long

' Make sure the menus aren't duplicated
Call DeleteMenu

Cap = Array("&Insert Row, Copy Formula", _
"&Delete Row on Database", _
"&Add New Group")

Mac = Array("macro1", _
"macro2", _
"macro3")

ShrtCutKey = Array("I", _
"D", _
"A")


' Get Index of Help Menu
HelpIndex = CommandBars(1).Controls("Help").Index

' Create the control
Set NewMenu = CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
before:=HelpIndex, temporary:=True)
NewMenu.Caption = MyMenuName
NewMenu.BeginGroup = "True"

CommandBars(1).Controls("Help").BeginGroup = True

' Add Menu Item
For iCtr = LBound(Cap) To UBound(Cap)
Set NewItem = NewMenu.Controls.Add(Type:=msoControlButton,
temporary:=True)
With NewItem
.Caption = Cap(iCtr)
.OnAction = "'" & ThisWorkbook.Name & "'!" & Mac(iCtr)
If ShrtCutKey(iCtr) = "" Then
'don't assign it
Else
.ShortcutText = "Ctrl+" & ShrtCutKey(iCtr)
'maybe add???
On Error Resume Next
'sometimes, I get errors, but the line always works
Application.MacroOptions Macro:=Mac(iCtr), _
HasShortcutKey:=True, ShortcutKey:=ShrtCutKey(iCtr)
On Error GoTo 0
End If
End With
Next iCtr

End Sub
Sub DeleteMenu()
On Error Resume Next
Application.CommandBars(1).Controls(MyMenuName).Delete
On Error GoTo 0
End Sub
Sub macro1()
MsgBox "hi from macro1"
End Sub
Sub macro2()
MsgBox "hi from macro2"
End Sub
Sub macro3()
MsgBox "hi from macro3"
End Sub

 

[Dave Peterson]

Ps.

If the code is not in a general module, then it's best to qualify the
commandbars object. And I added a line to remove the grouping before the Help
item when your new item is removed:

Option Explicit
Const MyMenuName As String = "Data&base Menu"
Sub Autpen()
Call AddNewMenu
End Sub
Sub Auto_Close()
Call DeleteMenu
End Sub
Sub AddNewMenu()
Dim NewMenu As CommandBarControl
Dim NewItem As CommandBarControl '<-- drop the trailing S
Dim HelpIndex As Long
Dim Cap As Variant
Dim Mac As Variant
Dim ShrtCutKey As Variant
Dim iCtr As Long

' Make sure the menus aren't duplicated
Call DeleteMenu

Cap = Array("&Insert Row, Copy Formula", _
"&Delete Row on Database", _
"&Add New Group")

Mac = Array("macro1", _
"macro2", _
"macro3")

ShrtCutKey = Array("I", _
"D", _
"A")


' Get Index of Help Menu
HelpIndex = Application.CommandBars(1).Controls("Help").Index

' Create the control
Set NewMenu = Application.CommandBars(1). _
Controls.Add(Type:=msoControlPopup, _
before:=HelpIndex, temporary:=True)
NewMenu.Caption = MyMenuName
NewMenu.BeginGroup = "True"

Application.CommandBars(1).Controls("Help").BeginGroup = True

' Add Menu Item
For iCtr = LBound(Cap) To UBound(Cap)
Set NewItem = NewMenu.Controls.Add(Type:=msoControlButton,
temporary:=True)
With NewItem
.Caption = Cap(iCtr)
.OnAction = "'" & ThisWorkbook.Name & "'!" & Mac(iCtr)
If ShrtCutKey(iCtr) = "" Then
'don't assign it
Else
.ShortcutText = "Ctrl+" & ShrtCutKey(iCtr)
'maybe add???
On Error Resume Next
'sometimes, I get errors, but the line always works
Application.MacroOptions Macro:=Mac(iCtr), _
HasShortcutKey:=True, ShortcutKey:=ShrtCutKey(iCtr)
On Error GoTo 0
End If
End With
Next iCtr

End Sub
Sub DeleteMenu()
On Error Resume Next
Application.CommandBars(1).Controls(MyMenuName).Delete
Application.CommandBars(1).Controls("Help").BeginGroup = False
On Error GoTo 0
End Sub
Sub macro1()
MsgBox "hi from macro1"
End Sub
Sub macro2()
MsgBox "hi from macro2"
End Sub
Sub macro3()
MsgBox "hi from macro3"
End Sub