In my spreadsheet cell I have a cell with the formula
=RunMacro("sample_macro('first';'second')", "double click me")
In my module I have
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
In my sheet code, I have
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
As desired, the cell displays "Double click me."
As desired, when the cell is double-clicked, the sample_macro is executed.
As desired, clicking any other cell simply goes into edit mode.
Not desired or understood: I get four message boxes. "first", "second", "first", "second".
Can anybody see a reason why?
Rory and Absinthe suggest correcting the syntax on the Application.run statement. Ike points out that I must pass macro name and parameters separately when dynamic. Thank you all!
Here is what I ended up with. I think it is a nice way to dynamically call an excel macro by double-clicking on a cell containing the macro name and parameters to be called.
In the cells, use a UDF with macro and parameters as the first element delimited with semicolons and the text to display as the second element. Something like these
=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")
In the code for the sheet, have the following
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
Then the macro to be called, if it has two or more parameters, must receive them as an array. Here is the contents of the module. The UDF is, of course, required. The others are samples.
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
CodePudding user response:
This works - but you have to pass the parameters as array
Application.Run is called by the macro - Arg1 - syntax.
worksheet module
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
Module
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