Pass arguments to macros from buttons and menus
2000-02-05 Commandbars 0 170
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("Cell") ' 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 = "MyMacroName1" 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