excel - 使用 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
解决方案
这有效 - 但您必须将参数作为数组传递
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
推荐阅读
- android - S3ObjectManager + AppSync + Okta 中的会话已过期
- android - 在 Android 中加载包含图像的 pptx
- php - 与3表的雄辩关系
- c# - Parallel.Invoke 等到 HttpClient 重新登录 c#
- mysql - 如果 postid 不存在,MySQL 将记录插入一个表到另一个表
- c++ - 使用 c++ 开发时,宏 '__TIME__' 和 '__TIMESTAMP__' 无法刷新
- android - 使用搜索视图过滤 gridview
- python - Python 依赖地狱:virtualenv 和全局依赖之间的妥协?
- ios - 斯威夫特 | UIBarButton 不工作/不去行动目标
- android - 在 Google Play 上更新应用程序时出现错误 DF-DFERH-01