Application.Run "....." invoked via a modelss displayed message's reply button

[warbe-maker]

Possible?

When a dialog is displayed ModeLess I wonder wheter is may be possible to invoke the service of a VB-Project via Application Run. If possible, a Button may be provided with an attached "Run-String" which is performed when the buttons is pressed. This wolud offer an enormous flexibility because by default there is no way back to the application which displayed a modeless message nor to any other services a Workbook provides.

[warbe-maker]

#22

Proof of concept

Introduction

The below is available for download in the Workbook RunViaButton.xlsm. It is already pretty close to ready for implementation. I.e. it has already my personal standard error message service implemented (see also the corresponding inline comments regarding this).

Attention: Running the test will require updating the Digital Sinature in the VBE or changing the Macro Security Settings.

Test UserForm module

The UserForm is named fRunViaButton and has a CommandButton named cmbRunViaButton with a caption Run via Button. The below is the UserForm's code.

Option Explicit
' ------------------------------------------------------------------------------
' UserForm fRunViaButton
'
' Proof of Concept: Invoke a service provided by a running (open) Workbook via
'                   a displayed message's button.
'
' Note: AppErr, ErrMsg, ErrSrc are used for a (my personal) minimum professional
'       error handling which (amongst others) supports a debugging option,
'       triggered by the Conditional Compile Argument "Debugging = 1".
'
' W. Rauschenberger, Berlin May 2022
' ------------------------------------------------------------------------------

Private dctApplicationRunArgs As Dictionary

Private Function AppErr(ByVal app_err_no As Long) As Long
' ------------------------------------------------------------------------------
' Ensures that a programmed (i.e. an application) error numbers never conflicts
' with the number of a VB runtime error. Thr function returns a given positive
' number (app_err_no) with the vbObjectError added - which turns it into a
' negative value. When the provided number is negative it returns the original
' positive "application" error number e.g. for being used with an error message.
' ------------------------------------------------------------------------------
    If app_err_no >= 0 Then AppErr = app_err_no + vbObjectError Else AppErr = Abs(app_err_no - vbObjectError)
End Function

Private Function ApplicationRunArgsGet(ByVal gra_button As String) As Collection
    Set ApplicationRunArgsGet = dctApplicationRunArgs(gra_button)
End Function

Private Sub cmbRunViaButton_Click()
    ApplicationRunViaButton Me.cmbRunViaButton.Caption ' does noting when no args had been provided
End Sub

Public Function ApplicationRunArgsLet(ByVal ar_button As String, _
                                      ByVal ar_wb As Workbook, _
                                      ByVal ar_service_name As String, _
                                 ParamArray ar_arguments() As Variant) As Long
' --------------------------------------------------------------------------
' Provides/stores Application.Run arguments for a button with a specific
' caption (ar_button) in a Dictionary with the button's caption (ar_button)
' as the key and the all other arguments (ar_wb, ar_service_name,
' ar_arguments) stowed in a Collection as item.
' Notes: - Because only positional arguments are supported by Application.Run
'          all arguments up to the last one used must be provided. I.e. it is
'          not possible to skip optional paramaters for their defaults.
'        - The function returns -1 when it raised an error
' --------------------------------------------------------------------------
    Const PROC = "ApplicationRunArgsLet"
    
    On Error GoTo eh
    Dim v   As Variant
    Dim cll As New Collection
    
    If dctApplicationRunArgs Is Nothing Then Set dctApplicationRunArgs = New Dictionary
    cll.Add ar_wb
    cll.Add ar_service_name
    For Each v In ar_arguments
        If TypeName(v) = "Error" Then
            Err.Raise Number:=AppErr(1) _
                    , Source:=ErrSrc(PROC) _
                    , Description:="The ParamArray argument (ar_arguments) contains empty elements though skipped " & _
                                   "optional arguments are not supported with the Application.Run operation!" & "||" & _
                                   "Optional raguments need to be specified up to the argument definitely used. I.e. " & _
                                   "only skipping is not possible but unused optional arguments may be omitted."
        Else
            cll.Add v
        End If
    Next v
    dctApplicationRunArgs.Add ar_button, cll
    Set cll = Nothing
    
xt: Exit Function

eh: Select Case ErrMsg(ErrSrc(PROC))
        Case vbResume:  Stop:                       Resume
        Case Else:      ApplicationRunArgsLet = -1: GoTo xt
    End Select
End Function

Private Sub ApplicationRunViaButton(ByVal ar_button As String)
' --------------------------------------------------------------------------
' Performs an Application.Run for a button's caption provided run arguments
' hd been provided via ApplicationRunArgsLet.
' --------------------------------------------------------------------------
    Const PROC = "ApplicationRunViaButton"
    
    On Error GoTo eh
    Dim cll         As Collection
    Dim sService    As String
    Dim wb          As Workbook
    
    If dctApplicationRunArgs.Exists(ar_button) Then
        Set cll = dctApplicationRunArgs(ar_button)
        Set wb = cll(1)
        sService = wb.Name & "!" & cll(2)
        
        Select Case cll.Count
            Case 2: Application.Run sService                 ' service call without arguments
            Case 3: Application.Run sService, cll(3)
            Case 4: Application.Run sService, cll(3), cll(4)
            Case 5: Application.Run sService, cll(3), cll(4), cll(5)
            Case 6: Application.Run sService, cll(3), cll(4), cll(5), cll(6)
            Case 7: Application.Run sService, cll(3), cll(4), cll(5), cll(6), cll(7)
            Case 8: Application.Run sService, cll(3), cll(4), cll(5), cll(6), cll(7), cll(8)
            Case 9: Application.Run sService, cll(3), cll(4), cll(5), cll(6), cll(7), cll(8), cll(9)
            Case 10: Application.Run sService, cll(3), cll(4), cll(5), cll(6), cll(7), cll(8), cll(9), cll(10)
            Case 11: Application.Run sService, cll(3), cll(4), cll(5), cll(6), cll(7), cll(8), cll(9), cll(10), cll(11)
            Case 12: Application.Run sService, cll(3), cll(4), cll(5), cll(6), cll(7), cll(8), cll(9), cll(10), cll(11), cll(12)
            Case 13: Application.Run sService, cll(3), cll(4), cll(5), cll(6), cll(7), cll(8), cll(9), cll(10), cll(11), cll(12), cll(13)
            Case 14: Application.Run sService, cll(3), cll(4), cll(5), cll(6), cll(7), cll(8), cll(9), cll(10), cll(11), cll(12), cll(13), cll(14)
            Case 15: Application.Run sService, cll(3), cll(4), cll(5), cll(6), cll(7), cll(8), cll(9), cll(10), cll(11), cll(12), cll(13), cll(14), cll(15)
            Case 16: Application.Run sService, cll(3), cll(4), cll(5), cll(6), cll(7), cll(8), cll(9), cll(10), cll(11), cll(12), cll(13), cll(14), cll(15), cll(16)
            End Select
    End If
    
xt: Exit Sub

eh: Select Case ErrMsg(ErrSrc(PROC))
        Case vbResume:  Stop: Resume
        Case Else:      GoTo xt
    End Select
End Sub

Private Function ErrSrc(ByVal sProc As String) As String
    ErrSrc = "fRunViaButton." & sProc
End Function

Private Function ErrMsg(ByVal err_source As String, _
               Optional ByVal err_no As Long = 0, _
               Optional ByVal err_dscrptn As String = vbNullString, _
               Optional ByVal err_line As Long = 0) As Variant
' ------------------------------------------------------------------------------
' Universal error message display service including a debugging option active
' when the Conditional Compile Argument 'Debugging = 1' and an optional
' additional "About the error:" section displaying text connected to an error
' message by two vertical bars (||).
'
' A copy of this function is used in each procedure with an error handling
' (On error Goto eh).
'
' The function considers the Common VBA Error Handling Component (ErH) which
' may be installed (Conditional Compile Argument 'ErHComp = 1') and/or the
' Common VBA Message Display Component (mMsg) installed (Conditional Compile
' Argument 'MsgComp = 1'). Only when none of the two is installed the error
' message is displayed by means of the VBA.MsgBox.
'
' Usage: Example with the Conditional Compile Argument 'Debugging = 1'
'
'        Private/Public <procedure-name>
'            Const PROC = "<procedure-name>"
'
'            On Error Goto eh
'            ....
'        xt: Exit Sub/Function/Property
'
'        eh: Select Case ErrMsg(ErrSrc(PROC))
'               Case vbResume:  Stop: Resume
'               Case Else:      GoTo xt
'            End Select
'        End Sub/Function/Property
'
'        The above may appear a lot of code lines but will be a godsend in case
'        of an error!
'
' Uses:  - For programmed application errors (Err.Raise AppErr(n), ....) the
'          function AppErr will be used which turns the positive number into a
'          negative one. The error message will regard a negative error number
'          as an 'Application Error' and will use AppErr to turn it back for
'          the message into its original positive number. Together with the
'          ErrSrc there will be no need to maintain numerous different error
'          numbers for a VB-Project.
'        - The caller provides the source of the error through the module
'          specific function ErrSrc(PROC) which adds the module name to the
'          procedure name.
'
' W. Rauschenberger Berlin, Nov 2021
' ------------------------------------------------------------------------------
#If ErHComp = 1 Then
    ErrMsg = mErH.ErrMsg(err_source, err_no, err_dscrptn, err_line)
    GoTo xt
#ElseIf MsgComp = 1 Then
    ErrMsg = mMsg.ErrMsg(err_source, err_no, err_dscrptn, err_line)
    GoTo xt
#End If
    '~~ -------------------------------------------------------------------
    '~~ When neither the mMsg nor the mErH component is installed the error
    '~~ message is displayed by means of the VBA.MsgBox
    '~~ -------------------------------------------------------------------
    Dim ErrBttns    As Variant
    Dim ErrAtLine   As String
    Dim ErrDesc     As String
    Dim ErrLine     As Long
    Dim ErrNo       As Long
    Dim ErrSrc      As String
    Dim ErrText     As String
    Dim ErrTitle    As String
    Dim ErrType     As String
    Dim ErrAbout    As String
        
    '~~ Obtain error information from the Err object for any argument not provided
    If err_no = 0 Then err_no = Err.Number
    If err_line = 0 Then ErrLine = Erl
    If err_source = vbNullString Then err_source = Err.Source
    If err_dscrptn = vbNullString Then err_dscrptn = Err.Description
    If err_dscrptn = vbNullString Then err_dscrptn = "--- No error description available ---"
    
    If InStr(err_dscrptn, "||") <> 0 Then
        ErrDesc = Split(err_dscrptn, "||")(0)
        ErrAbout = Split(err_dscrptn, "||")(1)
    Else
        ErrDesc = err_dscrptn
    End If
    
    '~~ Determine the type of error
    Select Case err_no
        Case Is < 0
            ErrNo = AppErr(err_no)
            ErrType = "Application Error "
        Case Else
            ErrNo = err_no
            If (InStr(1, err_dscrptn, "DAO") <> 0 _
            Or InStr(1, err_dscrptn, "ODBC Teradata Driver") <> 0 _
            Or InStr(1, err_dscrptn, "ODBC") <> 0 _
            Or InStr(1, err_dscrptn, "Oracle") <> 0) _
            Then ErrType = "Database Error " _
            Else ErrType = "VB Runtime Error "
    End Select
    
    If err_source <> vbNullString Then ErrSrc = " in: """ & err_source & """"   ' assemble ErrSrc from available information"
    If err_line <> 0 Then ErrAtLine = " at line " & err_line                    ' assemble ErrAtLine from available information
    ErrTitle = Replace(ErrType & ErrNo & ErrSrc & ErrAtLine, "  ", " ")         ' assemble ErrTitle from available information
       
    ErrText = "Error: " & vbLf & _
              ErrDesc & vbLf & vbLf & _
              "Source: " & vbLf & _
              err_source & ErrAtLine
    If ErrAbout <> vbNullString _
    Then ErrText = ErrText & vbLf & vbLf & _
                  "About: " & vbLf & _
                  ErrAbout
    
#If Debugging Then
    ErrBttns = vbYesNo
    ErrText = ErrText & vbLf & vbLf & _
              "Debugging:" & vbLf & _
              "Yes    = Resume Error Line" & vbLf & _
              "No     = Terminate"
#Else
    ErrBttns = vbCritical
#End If
    
    ErrMsg = MsgBox(Title:=ErrTitle _
                  , Prompt:=ErrText _
                  , Buttons:=ErrBttns)
xt: Exit Function

End Function

Test module

Option Explicit
' ------------------------------------------------------------------------------
' Standard Module mRunViaButton
'
' Proof of Concept: Invoke a service provided by a running (open) Workbook via
'                   a displayed message's button.
'
' Requires: Reference to the "Microsoft Scripting Runtime".
'
' Notes: - AppErr, ErrMsg, ErrSrc are used for a (my personal) minimum
'          professional error handling which (amongst others) supports a
'          debugging option, triggered by the Conditional Compile Argument
'          "Debugging = 1".
'        - getFrequency, getTickCount, MsgInstance, MsgInstanceTest are used
'          to provide an instance of the UserForm. A technique I do use
'          throughout all message services.
'
' W. Rauschenberger, Berlin May 2022
' ------------------------------------------------------------------------------
' Declarations used by "MsgInstance" to avoid conflicts when creating UserForm instances
Private Declare PtrSafe Function getFrequency Lib "kernel32" _
                Alias "QueryPerformanceFrequency" (TimerSystemFrequency As Currency) As Long
Private Declare PtrSafe Function getTickCount Lib "kernel32" _
                Alias "QueryPerformanceCounter" (cyTickCount As Currency) As Long
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
                
' In (my) standard VB-Projects declared with the module mMsg
Public Const vbResumeOk                         As Long = 7 ' Buttons value in mMsg.ErrMsg (pass on not supported)
Public Const vbResume                           As Long = 6 ' return value (equates to vbYes)
Public Type TypeMsgLabel
        FontBold        As Boolean
        FontColor       As XlRgbColor
        FontItalic      As Boolean
        FontName        As String
        FontSize        As Long
        FontUnderline   As Boolean
        MonoSpaced      As Boolean  ' FontName defaults to "Courier New"
        Text            As String
        OpenWhenClicked As String   ' this extra option is the purpose of this sepcific Type
End Type

Public Type TypeMsgText
        FontBold        As Boolean
        FontColor       As XlRgbColor
        FontItalic      As Boolean
        FontName        As String
        FontSize        As Long
        FontUnderline   As Boolean
        MonoSpaced      As Boolean  ' FontName defaults to "Courier New"
        Text            As String
End Type

Public Type TypeMsgSect:    Label As TypeMsgLabel:  Text As TypeMsgText:    End Type
Public Type TypeMsg:        Section(1 To 4) As TypeMsgSect:                 End Type
                

Private Function AppErr(ByVal app_err_no As Long) As Long
' ------------------------------------------------------------------------------
' Ensures that a programmed (i.e. an application) error numbers never conflicts
' with the number of a VB runtime error. Thr function returns a given positive
' number (app_err_no) with the vbObjectError added - which turns it into a
' negative value. When the provided number is negative it returns the original
' positive "application" error number e.g. for being used with an error message.
' ------------------------------------------------------------------------------
    If app_err_no >= 0 Then AppErr = app_err_no + vbObjectError Else AppErr = Abs(app_err_no - vbObjectError)
End Function

Private Function ErrMsg(ByVal err_source As String, _
               Optional ByVal err_no As Long = 0, _
               Optional ByVal err_dscrptn As String = vbNullString, _
               Optional ByVal err_line As Long = 0) As Variant
' ------------------------------------------------------------------------------
' Universal error message display service including a debugging option active
' when the Conditional Compile Argument 'Debugging = 1' and an optional
' additional "About the error:" section displaying text connected to an error
' message by two vertical bars (||).
'
' A copy of this function is used in each procedure with an error handling
' (On error Goto eh).
'
' The function considers the Common VBA Error Handling Component (ErH) which
' may be installed (Conditional Compile Argument 'ErHComp = 1') and/or the
' Common VBA Message Display Component (mMsg) installed (Conditional Compile
' Argument 'MsgComp = 1'). Only when none of the two is installed the error
' message is displayed by means of the VBA.MsgBox.
'
' Usage: Example with the Conditional Compile Argument 'Debugging = 1'
'
'        Private/Public <procedure-name>
'            Const PROC = "<procedure-name>"
'
'            On Error Goto eh
'            ....
'        xt: Exit Sub/Function/Property
'
'        eh: Select Case ErrMsg(ErrSrc(PROC))
'               Case vbResume:  Stop: Resume
'               Case Else:      GoTo xt
'            End Select
'        End Sub/Function/Property
'
'        The above may appear a lot of code lines but will be a godsend in case
'        of an error!
'
' Uses:  - For programmed application errors (Err.Raise AppErr(n), ....) the
'          function AppErr will be used which turns the positive number into a
'          negative one. The error message will regard a negative error number
'          as an 'Application Error' and will use AppErr to turn it back for
'          the message into its original positive number. Together with the
'          ErrSrc there will be no need to maintain numerous different error
'          numbers for a VB-Project.
'        - The caller provides the source of the error through the module
'          specific function ErrSrc(PROC) which adds the module name to the
'          procedure name.
'
' W. Rauschenberger Berlin, Nov 2021
' ------------------------------------------------------------------------------
#If ErHComp = 1 Then
    ErrMsg = mErH.ErrMsg(err_source, err_no, err_dscrptn, err_line)
    GoTo xt
#ElseIf MsgComp = 1 Then
    ErrMsg = mMsg.ErrMsg(err_source, err_no, err_dscrptn, err_line)
    GoTo xt
#End If
    '~~ -------------------------------------------------------------------
    '~~ When neither the mMsg nor the mErH component is installed the error
    '~~ message is displayed by means of the VBA.MsgBox
    '~~ -------------------------------------------------------------------
    Dim ErrBttns    As Variant
    Dim ErrAtLine   As String
    Dim ErrDesc     As String
    Dim ErrLine     As Long
    Dim ErrNo       As Long
    Dim ErrSrc      As String
    Dim ErrText     As String
    Dim ErrTitle    As String
    Dim ErrType     As String
    Dim ErrAbout    As String
        
    '~~ Obtain error information from the Err object for any argument not provided
    If err_no = 0 Then err_no = Err.Number
    If err_line = 0 Then ErrLine = Erl
    If err_source = vbNullString Then err_source = Err.Source
    If err_dscrptn = vbNullString Then err_dscrptn = Err.Description
    If err_dscrptn = vbNullString Then err_dscrptn = "--- No error description available ---"
    
    If InStr(err_dscrptn, "||") <> 0 Then
        ErrDesc = Split(err_dscrptn, "||")(0)
        ErrAbout = Split(err_dscrptn, "||")(1)
    Else
        ErrDesc = err_dscrptn
    End If
    
    '~~ Determine the type of error
    Select Case err_no
        Case Is < 0
            ErrNo = AppErr(err_no)
            ErrType = "Application Error "
        Case Else
            ErrNo = err_no
            If (InStr(1, err_dscrptn, "DAO") <> 0 _
            Or InStr(1, err_dscrptn, "ODBC Teradata Driver") <> 0 _
            Or InStr(1, err_dscrptn, "ODBC") <> 0 _
            Or InStr(1, err_dscrptn, "Oracle") <> 0) _
            Then ErrType = "Database Error " _
            Else ErrType = "VB Runtime Error "
    End Select
    
    If err_source <> vbNullString Then ErrSrc = " in: """ & err_source & """"   ' assemble ErrSrc from available information"
    If err_line <> 0 Then ErrAtLine = " at line " & err_line                    ' assemble ErrAtLine from available information
    ErrTitle = Replace(ErrType & ErrNo & ErrSrc & ErrAtLine, "  ", " ")         ' assemble ErrTitle from available information
       
    ErrText = "Error: " & vbLf & _
              ErrDesc & vbLf & vbLf & _
              "Source: " & vbLf & _
              err_source & ErrAtLine
    If ErrAbout <> vbNullString _
    Then ErrText = ErrText & vbLf & vbLf & _
                  "About: " & vbLf & _
                  ErrAbout
    
#If Debugging Then
    ErrBttns = vbYesNo
    ErrText = ErrText & vbLf & vbLf & _
              "Debugging:" & vbLf & _
              "Yes    = Resume Error Line" & vbLf & _
              "No     = Terminate"
#Else
    ErrBttns = vbCritical
#End If
    
    ErrMsg = MsgBox(Title:=ErrTitle _
                  , Prompt:=ErrText _
                  , Buttons:=ErrBttns)
xt: Exit Function

End Function

Private Function ErrSrc(ByVal es_name As String) As String
    ErrSrc = "mRunViaButton." & es_name
End Function

Private Function MsgInstance(ByVal fi_key As String, _
                    Optional ByVal fi_unload As Boolean = False) As fRunViaButton
' -------------------------------------------------------------------------
' Returns an instance of the UserForm fRunViaButton which is uniquely
' identified (fi_key) which usually is the title of the displayed message
' bu may be anything else as well (including an object). An already
' existing or new created instance is maintained in a static Dictionary
' with (fi_key) as the key and returned to the caller. When (fi_unload) is
' TRUE a possibly already existing Userform instance is unloaded.
' -------------------------------------------------------------------------
    Const PROC = "MsgInstance"
    
    Static cyStart      As Currency
    Static Instances    As Dictionary    ' Collection of (possibly still)  active form instances
    Dim MsecsElapsed    As Currency
    Dim MsecsWait       As Long
    
    If Instances Is Nothing Then Set Instances = New Dictionary
    
    If fi_unload Then
        If Instances.Exists(fi_key) Then
            On Error Resume Next
            Unload Instances(fi_key) ' The instance may be already unloaded
            Instances.Remove fi_key
        End If
        Exit Function
    End If
    
    If Not Instances.Exists(fi_key) Then
        '~~ When there is no evidence of an already existing instance a new one is established.
        '~~ In order not to interfere with any prior established instance a minimum wait time
        '~~ of 10 milliseconds is maintained.
        MsecsElapsed = (TicksCount() - cyStart) / CDec(TicksFrequency)
        MsecsWait = 10 - MsecsElapsed
        If MsecsWait > 0 Then
            Sleep MsecsWait
        End If
        cyStart = TicksCount()
        Set MsgInstance = New fRunViaButton
        Instances.Add fi_key, MsgInstance
    Else
        '~~ An instance identified by fi_key exists in the Dictionary.
        '~~ It may however have already been unloaded.
        On Error Resume Next
        Set MsgInstance = Instances(fi_key)
        Select Case Err.Number
            Case 0
            Case 13
                If Instances.Exists(fi_key) Then
                    Instances.Remove fi_key ' the no longer existing instance is removed from the Dictionary
                End If
                Set MsgInstance = New fRunViaButton
                Instances.Add fi_key, MsgInstance
            Case Else
                VBA.MsgBox "Unexpected error in mRunViaButton.MsgInstance", , "Unexpectd error"
        End Select
        On Error GoTo -1
    End If

End Function

Private Sub MsgInstanceTest()
    Const TEST_TITLE = "Test-Title"
    Dim i As Long
    
    For i = 1 To 5
        MsgInstance TEST_TITLE & i ' sleep for 10 milliseconds between the creation of two instances
    Next i
    
    For i = 1 To 5
        MsgInstance TEST_TITLE & i, True ' remove/unload all instances
    Next i

End Sub

Private Sub RunViaButton_ErrorTest()
' -------------------------------------------------------------------------
' Test: Optional skipped arguments are not supported by Application.Run and
' thus raise an error.
' -------------------------------------------------------------------------
    Const PROC = "RunViaButton_ErrorTest"
    
    On Error GoTo eh
    Dim fRun        As fRunViaButton
    Dim RunTitle    As String: RunTitle = "Application.Run via Button"
    
    Set fRun = MsgInstance(RunTitle)
    With fRun
        '~~ Arguments for the button with the caption "Run via Button"
        If .ApplicationRunArgsLet("Run via Button" _
                                , ThisWorkbook _
                                , "mRunViaButtonTest.Service" _
                                , "This message has been invoked via a message button" _
                                , "Run via button Test" _
                                , _
                                , "xxx") = 0 Then
            .Show False
        End If
    End With
    
xt: Exit Sub

eh: Select Case ErrMsg(ErrSrc(PROC))
        Case vbResume:  Stop: Resume
        Case Else:      GoTo xt
    End Select
End Sub

Private Sub RunViaButton_Test()
' -------------------------------------------------------------------------
' When the button in the UserForm is clicked the mMsg.Box service is called
' to display a message.
' Note: With Application.Run all arguments are "by position"! I.e. it is
'       not possible to skip optional arguments by means of naming them.
' -------------------------------------------------------------------------
    Const PROC = "RunViaButton_Test"
    
    On Error GoTo eh
    Dim fRun        As fRunViaButton
    Dim RunTitle    As String: RunTitle = "Application.Run via Button"
    
    Set fRun = MsgInstance(RunTitle)
    With fRun
        '~~ Arguments for the button with the caption "Run via Button"
        If .ApplicationRunArgsLet("Run via Button" _
                                , ThisWorkbook _
                                , "mRunViaButtonTest.Service" _
                                , "This message has been invoked via a message button" _
                                , "Run via button Test") = 0 Then
            .Show False
        End If
    End With
    
xt: Exit Sub

eh: Select Case ErrMsg(ErrSrc(PROC))
        Case vbResume:  Stop: Resume
        Case Else:      GoTo xt
    End Select
End Sub

Private Function TicksCount() As Currency:      getTickCount TicksCount:        End Function

Private Function TicksFrequency() As Currency:  getFrequency TicksFrequency:    End Function

Test module and service called via button

Option Explicit
' -------------------------------------------------------------------------
' Standard Module mRunViaButtonTest
'
' Test module providing a service called via message button.
' -------------------------------------------------------------------------

Public Sub Service(ByVal s_msg As String, _
                   ByVal s_title As String, _
                   Optional ByVal s_opt1 As String = vbNullString, _
                   Optional ByVal s_opt2 As String = vbNullString)
' -------------------------------------------------------------------------
' Test service called via message button. The optional arguments are only
' for an error test.
' -------------------------------------------------------------------------
                   
    VBA.MsgBox Prompt:=s_msg _
             , Title:=s_title _
             
End Sub

[warbe-maker]

The feature has already been implemented. The README and the related blog post had been updated correspondingly.