Excel VBA中Application.Run调用宏重复执行的原因及解决方案

问题背景 #

开发双击单元格触发指定宏功能时，使用Application.Run调用子过程出现了重复执行的异常。

最初实现代码 #

单元格公式 #

=RunMacro("sample_macro('first';'second')", "double click me")

标准模块代码 #

Option Explicit

Function RunMacro(macro_with_semicolons_and_apostrophes As String, display As String)
    
    RunMacro = display

End Function

Public Sub sample_macro(one As String, two As String)
    MsgBox one
    MsgBox two
End Sub

工作表模块代码 #

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Left(Target.Formula, 10) = "=RunMacro(" Then
     ' 阻止默认双击进入单元格编辑的行为
     Cancel = True
     ' 调用目标函数
     Application.Run Replace(Replace(Mid(Target.Formula, 12, InStr(11, Target.Formula, ",") - 13), ";", ","), "'", """")
 End If
    
End Sub

现象说明 #

• 符合预期的效果：单元格正常显示double click me，双击该单元格会触发sample_macro执行，点击其他单元格可正常进入编辑模式。
• 异常问题：双击后会弹出4次消息框，依次输出first、second、first、second，即sample_macro被执行了两次。

问题根因 #

动态调用宏时直接拼接参数字符串传给Application.Run会导致重复解析执行，正确做法是将宏名与参数分开传递。

最终实现方案 #

该方案支持调用无参、单参、多参的宏，多参宏只需接收数组类型的参数即可。

单元格公式写法示例 #

=RunMacro("sample_macro2;first;second", "run a macro with two parameters")

=RunMacro("sample_macro1;first", "run a macro with one parameter")

=RunMacro("sample_macro0", "run a macro with no parameters")

调整后的工作表代码 #

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Left(Target.Formula, 10) = "=RunMacro(" Then
    Dim myparams As Variant
    Dim mymacro As String
    Dim i As Integer
    ' 阻止默认双击进入单元格编辑的行为
    Cancel = True
    ' 拆分宏名和参数，分别传给Run方法
    myparams = Split(Mid(Target.Formula, 12, InStr(11, Target.Formula, ",") - 13), ";")
    mymacro = myparams(0)
    ' 移除数组中已经单独存储的宏名元素
    If UBound(myparams) > 1 Then
        For i = 1 To UBound(myparams)
            myparams(i - 1) = myparams(i)
        Next i
        ReDim Preserve myparams(UBound(myparams) - 1)
        Application.Run mymacro, myparams
    ElseIf UBound(myparams) = 1 Then
        Application.Run mymacro, myparams(1)
    Else
        Application.Run mymacro
    End If
    
 End If
    
End Sub

调整后的标准模块代码 #

Option Explicit

Function RunMacro(macro_with_semicolons_and_apostrophes As String, display As String)
    ' 自定义函数仅负责在单元格中显示指定文本，同时存储宏名和参数信息，双击事件触发前不会执行宏逻辑
    RunMacro = display
End Function

Public Sub sample_macro2(arrParameter As Variant)
    ' 2个及以上参数的宏统一接收数组类型参数即可
    Dim i As Long
    For i = LBound(arrParameter) To UBound(arrParameter)
        MsgBox arrParameter(i)
    Next
End Sub

Public Sub sample_macro1(myparam As Variant)
    MsgBox myparam
End Sub

Public Sub sample_macro0()
    MsgBox "you've reached two"
End Sub

内容的提问来源于stack exchange，提问作者James Bruehler