The example below shows how you can create CommandBar buttons/menus that passes one or more arguments to a macro.
the example also shows how you can add a new item to the Cell shortcut menu.
Sub AddCommandToCellShortcutMenu()
Dim i As Integer, ctrl As CommandBarButton
DeleteAllCustomControls ' delete the controls if they already exists
' create the new controls
With Application.CommandBars(25) ' the cell shortcut menu
' add an ordinary commandbarbutton
Set ctrl = .Controls.Add(msoControlButton, , , , True)
With ctrl
.BeginGroup = True
.Caption = "New Menu1"
.FaceId = 71
.State = msoButtonUp
.Style = msoButtonIconAndCaption
.Tag = "TESTTAG1"
.OnAction = "MyMacroName2"
End With
' add a button that passes one string argument
Set ctrl = .Controls.Add(msoControlButton, , , , True)
With ctrl
.BeginGroup = False
.Caption = "New Menu2"
.FaceId = 72
.Style = msoButtonIconAndCaption
.Tag = "TESTTAG2"
.OnAction = "'MyMacroName2 ""New Menu2""'"
End With
' add a button that passes passes one string argument
Set ctrl = .Controls.Add(msoControlButton, , , , True)
With ctrl
.BeginGroup = False
.Caption = "New Menu3"
.FaceId = 73
.Style = msoButtonIconAndCaption
.Tag = "TESTTAG3"
.OnAction = "'MyMacroName2 """ & .Caption & """'"
End With
' add a button that passes two arguments, a string and an integer
Set ctrl = .Controls.Add(msoControlButton, , , , True)
With ctrl
.BeginGroup = False
.Caption = "New Menu4"
.FaceId = 74
.Style = msoButtonIconAndCaption
.Tag = "TESTTAG4"
.OnAction = "'MyMacroName3 """ & .Caption & """, 10'"
End With
End With
Set ctrl = Nothing
End Sub
Sub DeleteAllCustomControls()
' delete the controls if they already exists
Dim i As Integer
For i = 1 To 4
DeleteCustomCommandBarControl "TESTTAG" & i
Next i
End Sub
Private Sub DeleteCustomCommandBarControl(CustomControlTag As String)
' deletes ALL CommandBar controls with Tag = CustomControlTag
On Error Resume Next
Do
Application.CommandBars.FindControl(, , CustomControlTag, False).Delete
Loop Until Application.CommandBars.FindControl(, , _
CustomControlTag, False) Is Nothing
On Error GoTo 0
End Sub
' example macros used by the commandbar buttons
Sub MyMacroName1()
MsgBox "The time is " & Format(Time, "hh:mm:ss")
End Sub
Sub MyMacroName2(Optional MsgBoxCaption As String = "UNKNOWN")
MsgBox "The time is " & Format(Time, "hh:mm:ss"), , _
"This macro was started from " & MsgBoxCaption
End Sub
Sub MyMacroName3(MsgBoxCaption As String, DisplayValue As Integer)
MsgBox "The time is " & Format(Time, "hh:mm:ss"), , _
MsgBoxCaption & " " & DisplayValue
End Sub
|
