首页 > 解决方案 > 使用 excel VBA,为什么我的 sub 似乎使用 Application.run 运行了两次?

问题描述

在我的电子表格单元格中,我有一个带有公式的单元格

=RunMacro("sample_macro('first';'second')", "双击我")

在我的模块中,我有

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
     ' Prevent default double-click action
     Cancel = True
     ' call function
     Application.run Replace(Replace(Mid(Target.Formula, 12, InStr(11, Target.Formula, ",") - 13), ";", ","), "'", """")
 End If
    
End Sub

根据需要,单元格显示“双击我”。

根据需要,当双击单元格时,将执行 sample_macro。

根据需要,单击任何其他单元格即可进入编辑模式。

不想要或不理解:我收到四个消息框。“第一”、“第二”、“第一”、“第二”。

任何人都可以看到原因吗?

Rory 和 Absinthe 建议更正 Application.run 语句的语法。Ike 指出我必须在动态时分别传递宏名称和参数。谢谢你们!

这就是我最终得到的。我认为这是通过双击包含要调用的宏名称和参数的单元格来动态调用 excel 宏的好方法。

在单元格中,使用带有宏和参数的 UDF 作为第一个以分号分隔的元素,将要显示的文本作为第二个元素。像这样的东西

=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
    ' Prevent default double-click action
    Cancel = True
    ' preparemacro name and parameters to be provided seperately to run function
    myparams = Split(Mid(Target.Formula, 12, InStr(11, Target.Formula, ",") - 13), ";")
    mymacro = myparams(0)
    ' stip off first element now saved in string
    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

然后要调用的宏,如果它有两个或多个参数,则必须将它们作为数组接收。这是模块的内容。当然,UDF 是必需的。其他是样品。

Option Explicit

Function RunMacro(macro_with_semicolons_and_apostrophes As String, display As String)
    ' this is the UDF.  It permits us to hold the name of the macro and the parameteres (if any) in the cell
    ' but it merely displays the display text unless/until double-clicked
    RunMacro = display
End Function

Public Sub sample_macro2(arrParameter As Variant)
    ' macros with 2 or more parameters must receive them as an array
    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


标签: excelvba

解决方案


这有效 - 但您必须将参数作为数组传递

Application.Run 由宏 - Arg1 - 语法调用。

工作表模块

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
 If Left(Target.Formula, 10) = "=RunMacro(" Then
     ' Prevent default double-click action
     Cancel = True
     ' call function
     'Application.Run Replace(Replace(Mid(Target.Formula, 12, InStr(11, Target.Formula, ",") - 13), ";", ";"), "'", """")
     'Application.Run "sample_macro(""first"";""second"")"
     Application.Run getMacro(Target.Formula), getParameter(Target.Formula)
 End If

End Sub


Private Function getMacro(value As String) As String
getMacro = Mid(value, InStr(value, "(") + 2)
getMacro = Left(getMacro, InStr(getMacro, "(") - 1)
End Function

Private Function getParameter(value As String) As Variant
getParameter = Mid(value, InStr(value, "'"))
getParameter = Left(getParameter, InStr(getParameter, ")") - 1)
getParameter = Split(Replace(getParameter, "'", vbNullString), ";")
End Function

模块

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

Public Sub sample_macro(arrParameter As Variant)
    Dim i As Long
    For i = LBound(arrParameter) To UBound(arrParameter)
        MsgBox arrParameter(i)
    Next
End Sub


推荐阅读