0.README.md

[Excel][VBA] Application.RunとCallByNameの共通化 （挫折中）

Function CallByNameExt(target_object As Object, ByVal proc_name As String, ParamArray args() As Variant) As Variant
  target_object: 関数を実行するオブジェクト（Nothing指定時はApplication.Run、それ以外は CallByNameを内部的に呼び出し）
  proc_name: 実行するオブジェクトのメソッド名
  args(): メソッドに指定する引数（省略可・複数指定可）

のような関数を作りたかった （過去形） 。

→ 引数の数に制限（最大30個）はあるものの、力技でなんとかしてみた。

ソースコード

1. 本体標準モジュール（Module_CallByNameExt.vba）
2. テスト用クラス モジュール (Class_Test.vba)
3. テスト用標準モジュール (Class_Test.vba)

問題点

• 一見動作するようにはなったが、全ての引数がByVal扱いとなってしまう（呼び出し先での変更が反映されない）。

関連

• ParamArrayで受けたものを別プロシージャのParamArrayに渡す方法がわからない → それは誰もがつまずく問題!?
• Application.RunやCallByNameでの引数はByVal？ByRef？

参考

• Passing an array of Arguments to CallByName VBA - Stack Overflow
• VBAのApplication.Runで変数を参照渡しする方法 - えくせるちゅんちゅん
• VBA 参照不可変数を作成するTake2 for Run関数 – Dropbox Paper
• 省略可能なVariant引数の参照不可をラップ関数で利用｜VBA技術解説

Class_Test.vba

Option Explicit

Private LocalValues As Variant

Function Init(ParamArray args() As Variant)
    LocalValues = args
    Set Init = Me
End Function

Function MyAdd(value As Long) As Long
    value = value + 1
    MyAdd = value
End Function

Module_CallByNameExt.vba

Option Explicit

#If VBA7 Then
  Private Declare PtrSafe Function rtcCallByName Lib "VBE7.DLL" ( _
    ByVal Object As Object, _
    ByVal ProcName As LongPtr, _
    ByVal CallType As VbCallType, _
    ByRef args() As Any, _
    Optional ByVal lcid As Long) As Variant
#Else
  Private Declare Function rtcCallByName Lib "VBE6.DLL" ( _
    ByVal Object As Object, _
    ByVal ProcName As Long, _
    ByVal CallType As VbCallType, _
    ByRef args() As Any, _
    Optional ByVal lcid As Long) As Variant
#End If

Function CallByNameExt_DLL(target_object As Object, ByVal proc_name As String, ParamArray args() As Variant) As Variant
    ' TODO: 可変引数（args()）中に、呼び出し先プロシージャにて ByRef 指定のものがあったとしても、無視されてしまう（ByVal相当）
    Dim arg_object As Object
    Dim arg_list() As Variant
    Dim index As Long

    If target_object Is Nothing Then
        Set arg_object = Application

        If UBound(args) - LBound(args) + 1 <= 0 Then
            arg_list = Array(proc_name)
        Else
            ReDim arg_list(LBound(args) To UBound(args) + 1)
            arg_list(0) = proc_name
            For index = LBound(args) To UBound(args)
                Call AssignValue(arg_list(index + 1), args(index))
            Next index
        End If
        proc_name = "Run"
    Else
        Set arg_object = target_object
'        If UBound(args) - LBound(args) + 1 <= 0 Then
'            arg_list = Array()
'        Else
'            ReDim arg_list(LBound(args) To UBound(args))
'            For index = LBound(args) To UBound(args)
'                Call AssignValue(arg_list(index), args(index))
'            Next index
'        End If
        arg_list = args
    End If
    
    Call AssignValue(CallByNameExt_DLL, rtcCallByName(arg_object, StrPtr(proc_name), VbMethod, arg_list))
End Function


Function CallByNameExt(target_object As Object, ByVal proc_name As String, ParamArray args() As Variant) As Variant
    If target_object Is Nothing Then
        Select Case UBound(args)
            Case -1: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name)
            Case 0: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0))
            Case 1: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1))
            Case 2: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2))
            Case 3: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3))
            Case 4: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4))
            Case 5: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5))
            Case 6: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6))
            Case 7: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7))
            Case 8: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8))
            Case 9: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9))
            Case 10: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10))
            Case 11: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11))
            Case 12: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12))
            Case 13: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13))
            Case 14: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14))
            Case 15: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15))
            Case 16: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16))
            Case 17: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17))
            Case 18: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18))
            Case 19: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19))
            Case 20: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20))
            Case 21: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21))
            Case 22: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22))
            Case 23: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23))
            Case 24: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24))
            Case 25: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25))
            Case 26: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26))
            Case 27: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27))
            Case 28: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27), args(28))
            Case 29: AssignValue CallByNameExt, CallByName(Application, "Run", VbMethod, proc_name, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27), args(28), args(29))
            Case Else: Err.Raise 450
        End Select
    Else
        Select Case UBound(args)
            Case -1: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod)
            Case 0: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0))
            Case 1: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1))
            Case 2: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2))
            Case 3: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3))
            Case 4: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4))
            Case 5: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5))
            Case 6: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6))
            Case 7: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7))
            Case 8: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8))
            Case 9: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9))
            Case 10: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10))
            Case 11: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11))
            Case 12: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12))
            Case 13: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13))
            Case 14: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14))
            Case 15: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15))
            Case 16: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16))
            Case 17: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17))
            Case 18: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18))
            Case 19: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19))
            Case 20: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20))
            Case 21: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21))
            Case 22: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22))
            Case 23: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23))
            Case 24: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24))
            Case 25: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25))
            Case 26: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26))
            Case 27: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27))
            Case 28: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27), args(28))
            Case 29: AssignValue CallByNameExt, CallByName(target_object, proc_name, VbMethod, args(0), args(1), args(2), args(3), args(4), args(5), args(6), args(7), args(8), args(9), args(10), args(11), args(12), args(13), args(14), args(15), args(16), args(17), args(18), args(19), args(20), args(21), args(22), args(23), args(24), args(25), args(26), args(27), args(28), args(29))
            Case Else: Err.Raise 450
        End Select
    End If
 End Function

Sub AssignValue(ByRef target As Variant, ByRef source As Variant)
    If IsObject(source) Then
        Set target = source
    Else
        target = source
    End If
End Sub

Module_Test.vba

Option Explicit

Sub TestCallByNameExt()
    Dim arr
    Dim value1 As Long: value1 = 100
    Dim value2 As Long: value2 = 200

    arr = Array( _
        CallByNameExt(New Class_Test, "init", 1, 2, 3), _
        CallByNameExt(New Class_Test, "MyAdd", value1), _
        CallByNameExt(Nothing, "TestInitObject"), _
        CallByNameExt(Nothing, "MyAdd", value2) _
    )

    Stop
End Sub

Function TestInitObject()
    Dim obj As New Class_Test
    Set TestInitObject = obj.Init(10, 20, 30)
End Function

Function MyAdd(value As Long) As Long
    value = value + 1
    MyAdd = value
End Function