🦒

Excel VBAをクラスを使って改善しよう：スタックトレースログ出力自動化

2023/09/18に公開

オブジェクト指向

VBA

Excel VBA

tech

開発経緯

VBAでは実行時エラーが発生した場合、VBEから呼び出し履歴（CTRL＋L）でスタックトレースの確認が可能ですが、これは中断時しか確認することが出来ません。

ですので、各プロシージャ呼び出しの開始と終了でログ出力を行うことがあるかと思います。

Public Sub レガシーなスタックトレースログ出力()
    Debug.Print "レガシーなスタックトレースログ出力() " & ": 開始 """

    '何かの処理を行う

    Debug.Print "レガシーなスタックトレースログ出力() " & ": 終了 """
End Sub

かなり簡易な実装で、関数を定数にするとかログ用の共通プロシージャを作ったほうが良いとか色々とツッコミはあるかと思いますが、骨子はプロシージャに1つずつログ埋め込みが必要といういうことです。

別にこれでも悪くはないのですが、以下の点で課題があります。

プロシージャ名を変更したらログ出力も修正が必要
ログ出力し忘れても気が付かない、または面倒であえてやらなくなる
プロシージャなどの小さいレベルでも実装するのか・しないのか判断に迷う

これらの課題に対して、どうにかできないかを考えてみました。

解決の糸口はCallByName

CallByNameはクラスのメソッドやプロパティを文字列で指定して実行することが出来ます。
多少のパフォーマンス劣化にはなりますが、遅ければ使う箇所を少なくすればよいだけです。

発想としては、CallByNameの前後にログ出力する仕組みを作った標準モジュールを作成すればよい、という単純なものです。

ただし、単純であることと簡単であることは異なるため、実装はそれなりに苦労しました。
利用する側はCallByNameとそれほど違いなく利用できます。

早速実装を見ていきましょう。

利用する側のコード

まずは利用する側のコードを見ていきます。このほうがステップを追っていけるので今回は分かりやすいかと思います。

テストモジュール

Public Sub Test()
    Debug.Print CallGetPropertyByName(ThisWorkbook, "Name")
    Debug.Print TypeName(CallGetPropertyByName(ThisWorkbook, "WorkSheets"))
    Debug.Print CallGetPropertyByName(CallGetPropertyByName(ThisWorkbook, "WorkSheets", "Sheet1"), "Name")
End Sub

実行結果は以下の通り。

2023/09/15 16:07:30.452 START: Workbook#Name(VbGet)
2023/09/15 16:07:30.454 FINISH: Workbook#Name(VbGet)
ログ出力.xlsm
2023/09/15 16:07:30.456 START: Workbook#WorkSheets(VbGet)
2023/09/15 16:07:30.456 FINISH: Workbook#WorkSheets(VbGet)
Sheets
2023/09/15 16:07:30.458 START: Workbook#WorkSheets(VbGet)
2023/09/15 16:07:30.459 FINISH: Workbook#WorkSheets(VbGet)
2023/09/15 16:07:30.460 START: Worksheet#Name(VbGet)
2023/09/15 16:07:30.460 FINISH: Worksheet#Name(VbGet)
Sheet1

CallGetPropertyByName は値を取得するプロパティに使います。
使い方はCallByNameとほぼ同様で、CallByNameの第3引数であるVbCallType別にプロシージャにしているだけです。今回はVbGetを指定した時と同様の動作になります。

CallByNameと異なるのは、実行前と後にログが出力されることです。
YYYY/MM/DD hh:mm:ss.fff START: クラス型名#メソッド・プロパティ名(実行タイプ)
YYYY/MM/DD hh:mm:ss.fff FINISH: クラス型名#メソッド・プロパティ名(実行タイプ)

また、可変長引数は10個までとしています。

他に以下のプロシージャを用意しました。
CallSubByName
CallFunctionByName
CallSetPropertyByName
CallLetPropertyByName

メソッドは戻り値がないSubプロシージャと戻り値のあるFunctionプロシージャを分けて実装しています。
この辺りは後でまとめてテストした内容を確認していきます。

CallUtilモジュール

それではまずは実行本体の実装を見ていきます。
かなり長いので覚悟してください。

CallUtil

Option Explicit
Option Private Module

Public Function CallFunctionByName(pObj As Object, pMethodName As String, Optional pArgs1 As Variant, Optional pArgs2 As Variant, Optional pArgs3 As Variant, Optional pArgs4 As Variant, Optional pArgs5 As Variant, Optional pArgs6 As Variant, Optional pArgs7 As Variant, Optional pArgs8 As Variant, Optional pArgs9 As Variant, Optional pArgs10 As Variant) As Variant
    Dim vParams As CallUtilParameter
    Set vParams = CreateParamter(pArgs1, pArgs2, pArgs3, pArgs4, pArgs5, pArgs6, pArgs7, pArgs8, pArgs9, pArgs10)
    
    Dim vOutValue As CallUtilValue
    Set vOutValue = CallByNameEx(pObj, pMethodName, VbMethod, vParams)
    
    If vOutValue.IsObject Then
        Set CallFunctionByName = vOutValue.Value
    Else
        CallFunctionByName = vOutValue.Value
    End If
End Function

Public Sub CallSubByName(pObj As Object, pMethodName As String, Optional pArgs1 As Variant, Optional pArgs2 As Variant, Optional pArgs3 As Variant, Optional pArgs4 As Variant, Optional pArgs5 As Variant, Optional pArgs6 As Variant, Optional pArgs7 As Variant, Optional pArgs8 As Variant, Optional pArgs9 As Variant, Optional pArgs10 As Variant)
    Dim vParams As CallUtilParameter
    Set vParams = CreateParamter(pArgs1, pArgs2, pArgs3, pArgs4, pArgs5, pArgs6, pArgs7, pArgs8, pArgs9, pArgs10)
    Call CallByNameEx(pObj, pMethodName, VbMethod, vParams)
End Sub

Public Function CallGetPropertyByName(pObj As Object, pMethodName As String, Optional pArgs1 As Variant, Optional pArgs2 As Variant, Optional pArgs3 As Variant, Optional pArgs4 As Variant, Optional pArgs5 As Variant, Optional pArgs6 As Variant, Optional pArgs7 As Variant, Optional pArgs8 As Variant, Optional pArgs9 As Variant, Optional pArgs10 As Variant) As Variant
    Dim vParams As CallUtilParameter
    Set vParams = CreateParamter(pArgs1, pArgs2, pArgs3, pArgs4, pArgs5, pArgs6, pArgs7, pArgs8, pArgs9, pArgs10)
    
    Dim vOutValue As CallUtilValue
    Set vOutValue = CallByNameEx(pObj, pMethodName, VbGet, vParams)
    
    If vOutValue.IsObject Then
        Set CallGetPropertyByName = vOutValue.Value
    Else
        CallGetPropertyByName = vOutValue.Value
    End If
End Function

Public Sub CallLetPropertyByName(pObj As Object, pMethodName As String, Optional pArgs1 As Variant, Optional pArgs2 As Variant, Optional pArgs3 As Variant, Optional pArgs4 As Variant, Optional pArgs5 As Variant, Optional pArgs6 As Variant, Optional pArgs7 As Variant, Optional pArgs8 As Variant, Optional pArgs9 As Variant, Optional pArgs10 As Variant)
    Dim vParams As CallUtilParameter
    Set vParams = CreateParamter(pArgs1, pArgs2, pArgs3, pArgs4, pArgs5, pArgs6, pArgs7, pArgs8, pArgs9, pArgs10)
    Call CallByNameEx(pObj, pMethodName, VbLet, vParams)
End Sub

Public Sub CallSetPropertyByName(pObj As Object, pMethodName As String, Optional pArgs1 As Variant, Optional pArgs2 As Variant, Optional pArgs3 As Variant, Optional pArgs4 As Variant, Optional pArgs5 As Variant, Optional pArgs6 As Variant, Optional pArgs7 As Variant, Optional pArgs8 As Variant, Optional pArgs9 As Variant, Optional pArgs10 As Variant)
    Dim vParams As CallUtilParameter
    Set vParams = CreateParamter(pArgs1, pArgs2, pArgs3, pArgs4, pArgs5, pArgs6, pArgs7, pArgs8, pArgs9, pArgs10)
    Call CallByNameEx(pObj, pMethodName, VbSet, vParams)
End Sub

Private Function CreateParamter(Optional pArgs1 As Variant, Optional pArgs2 As Variant, Optional pArgs3 As Variant, Optional pArgs4 As Variant, Optional pArgs5 As Variant, Optional pArgs6 As Variant, Optional pArgs7 As Variant, Optional pArgs8 As Variant, Optional pArgs9 As Variant, Optional pArgs10 As Variant) As CallUtilParameter
    With New CallUtilParameter
        Set CreateParamter = .Init(pArgs1, pArgs2, pArgs3, pArgs4, pArgs5, pArgs6, pArgs7, pArgs8, pArgs9, pArgs10)
    End With
End Function

Private Function CallByNameEx(pObj As Object, pMethodName As String, pType As VbCallType, pParams As CallUtilParameter) As CallUtilValue
    
    Call Logger.Start(TypeName(pObj), pMethodName, pType)
    
    Select Case pParams.Count
        Case 0
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType))
        Case 1
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1))
        Case 2
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2))
        Case 3
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3))
        Case 4
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4))
        Case 5
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4, pParams.Args5))
        Case 6
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4, pParams.Args5, pParams.Args6))
        Case 7
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4, pParams.Args5, pParams.Args6, pParams.Args7))
        Case 8
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4, pParams.Args5, pParams.Args6, pParams.Args7, pParams.Args8))
        Case 9
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4, pParams.Args5, pParams.Args6, pParams.Args7, pParams.Args8, pParams.Args9))
        Case 10
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4, pParams.Args5, pParams.Args6, pParams.Args7, pParams.Args8, pParams.Args9, pParams.Args10))
        Case Else
            Debug.Print "引数の設定が不正です"
            Debug.Assert False
            Set CallByNameEx = Nothing
    End Select

    Call Logger.Finish(TypeName(pObj), pMethodName, pType)

End Function

Public Function CreateValue(pValue As Variant) As CallUtilValue
    With New CallUtilValue
        Set CreateValue = .Init(pValue)
    End With
End Function

CallGetPropertyByNameを例に説明します。

シグニチャ

Public Function CallGetPropertyByName(pObj As Object, pMethodName As String, Optional pArgs1 As Variant, Optional pArgs2 As Variant, Optional pArgs3 As Variant, Optional pArgs4 As Variant, Optional pArgs5 As Variant, Optional pArgs6 As Variant, Optional pArgs7 As Variant, Optional pArgs8 As Variant, Optional pArgs9 As Variant, Optional pArgs10 As Variant) As Variant

第1引数、第2引数はCallByNameと同様、第1引数がオブジェクト、第2引数は実行したいメソッド名の文字列です。
第3引数以降は、可変長引数を表現するための省略可能な引数を10個用意しています。

ParamArrayを使ってもよかったのですが、後述しますが固定数でなければCallByNameをラッピングすることが難しかったため、あえて10個までしか設定できないことを明示するためにParamArrayを使うのは却下しました。

パラメータ管理クラス

次に引数で受け取った省略可能な引数を管理するためのクラスを作成します。

    Dim vParams As CallUtilParameter
    Set vParams = CreateParamter(pArgs1, pArgs2, pArgs3, pArgs4, pArgs5, pArgs6, pArgs7, pArgs8, pArgs9, pArgs10)

CreateParamterは単純なファクトリです。

Private Function CreateParamter(Optional pArgs1 As Variant, Optional pArgs2 As Variant, Optional pArgs3 As Variant, Optional pArgs4 As Variant, Optional pArgs5 As Variant, Optional pArgs6 As Variant, Optional pArgs7 As Variant, Optional pArgs8 As Variant, Optional pArgs9 As Variant, Optional pArgs10 As Variant) As CallUtilParameter
    With New CallUtilParameter
        Set CreateParamter = .Init(pArgs1, pArgs2, pArgs3, pArgs4, pArgs5, pArgs6, pArgs7, pArgs8, pArgs9, pArgs10)
    End With
End Function

CallUtilParameterクラスの本体です。

CallUtilParameterクラス

Option Explicit

Private mArgs1 As CallUtilValue
Private mArgs2 As CallUtilValue
Private mArgs3 As CallUtilValue
Private mArgs4 As CallUtilValue
Private mArgs5 As CallUtilValue
Private mArgs6 As CallUtilValue
Private mArgs7 As CallUtilValue
Private mArgs8 As CallUtilValue
Private mArgs9 As CallUtilValue
Private mArgs10 As CallUtilValue

Public Function Init(Optional pArgs1 As Variant, Optional pArgs2 As Variant, Optional pArgs3 As Variant, Optional pArgs4 As Variant, Optional pArgs5 As Variant, Optional pArgs6 As Variant, Optional pArgs7 As Variant, Optional pArgs8 As Variant, Optional pArgs9 As Variant, Optional pArgs10 As Variant) As CallUtilParameter
    Set mArgs1 = CreateValue(pArgs1)
    Set mArgs2 = CreateValue(pArgs2)
    Set mArgs3 = CreateValue(pArgs3)
    Set mArgs4 = CreateValue(pArgs4)
    Set mArgs5 = CreateValue(pArgs5)
    Set mArgs6 = CreateValue(pArgs6)
    Set mArgs7 = CreateValue(pArgs7)
    Set mArgs8 = CreateValue(pArgs8)
    Set mArgs9 = CreateValue(pArgs9)
    Set mArgs10 = CreateValue(pArgs10)
    Set Init = Me
End Function

Public Function Count() As Long
    If mArgs1.IsMissing Then
        Count = 0
    ElseIf mArgs2.IsMissing Then
        Count = 1
    ElseIf mArgs3.IsMissing Then
        Count = 2
    ElseIf mArgs4.IsMissing Then
        Count = 3
    ElseIf mArgs5.IsMissing Then
        Count = 4
    ElseIf mArgs6.IsMissing Then
        Count = 5
    ElseIf mArgs7.IsMissing Then
        Count = 6
    ElseIf mArgs8.IsMissing Then
        Count = 7
    ElseIf mArgs9.IsMissing Then
        Count = 8
    ElseIf mArgs10.IsMissing Then
        Count = 9
    Else
        Debug.Print "引数が10以上設定されています。"
        Debug.Assert False
        Count = -1
    End If
End Function

Public Property Get Args1() As Variant
    If mArgs1.IsObject Then
        Set Args1 = mArgs1.Value
    Else
        Args1 = mArgs1.Value
    End If
End Property

Public Property Get Args2() As Variant
    If mArgs2.IsObject Then
        Set Args2 = mArgs2.Value
    Else
        Args2 = mArgs2.Value
    End If
End Property

Public Property Get Args3() As Variant
    If mArgs3.IsObject Then
        Set Args3 = mArgs3.Value
    Else
        Args3 = mArgs3.Value
    End If
End Property

Public Property Get Args4() As Variant
    If mArgs4.IsObject Then
        Set Args4 = mArgs4.Value
    Else
        Args4 = mArgs4.Value
    End If
End Property

Public Property Get Args5() As Variant
    If mArgs5.IsObject Then
        Set Args5 = mArgs5.Value
    Else
        Args5 = mArgs5.Value
    End If
End Property

Public Property Get Args6() As Variant
    If mArgs6.IsObject Then
        Set Args6 = mArgs6.Value
    Else
        Args6 = mArgs6.Value
    End If
End Property

Public Property Get Args7() As Variant
    If mArgs7.IsObject Then
        Set Args7 = mArgs7.Value
    Else
        Args7 = mArgs7.Value
    End If
End Property

Public Property Get Args8() As Variant
    If mArgs8.IsObject Then
        Set Args8 = mArgs8.Value
    Else
        Args8 = mArgs8.Value
    End If
End Property

Public Property Get Args9() As Variant
    If mArgs9.IsObject Then
        Set Args9 = mArgs9.Value
    Else
        Args9 = mArgs9.Value
    End If
End Property

Public Property Get Args10() As Variant
    If mArgs10.IsObject Then
        Set Args10 = mArgs10.Value
    Else
        Args10 = mArgs10.Value
    End If
End Property

CallUtilParameterクラスのメンバーフィールドにある10個のCallUtilValueクラスのオブジェクトはこのアプリケーションの値クラスです。こちらは後で解説します。

CallUtilParameterクラスは責務は非常に単純です。
10個の引数を保持して、必要な時にプロパティで取得できるようにしているだけです。
ただし、値がオブジェクトかそうでないかを判断するロジックをここにカプセル化しています。

CallUtilValueクラスで値の状態を管理する

次に、CallUtilValueクラスをみていきます。
このクラスは値の状態を管理することが責務です。

CallUtilValueクラス

Option Explicit

Private mMissingFlag As Boolean
Private mObjFlag As Boolean
Private mValue As Variant

Public Function Init(pValue As Variant) As CallUtilValue
    
    If Information.IsMissing(pValue) Then
        mMissingFlag = True
        mValue = pValue
        Set Init = Me
        Exit Function
    End If
    
    mObjFlag = Information.IsObject(pValue)
    If mObjFlag Then
        Set mValue = pValue
    Else
        mValue = pValue
    End If
    Set Init = Me
End Function

Public Function IsObject() As Boolean
    IsObject = mObjFlag
End Function

Public Property Get Value() As Variant
    If mObjFlag Then
        Set Value = mValue
    Else
        Value = mValue
    End If
End Property

Public Function IsMissing() As Boolean
    IsMissing = mMissingFlag
End Function

値はVariant型であるため、変数に保持する（プリミティブ型なら代入、オブジェクト型なら参照）度に、チェックを行う必要があることから、初期化で状態を保持しています。
突貫工事で作成したため、再初期化を防止するようなコードは入れていません。

また、省略可能な引数は省略された場合、参照不能の引数となります。
これはInformation.IsMissing(pValue)でチェックすることができます。
これが必要な理由は、参照不能の値をCallByNameに渡すとエラーになるためです。

では、元のCallUtilモジュールのほうに戻ります。

CallByNameExでCallByNameをラッピングする

CallByNameExでCallByNameをラッピングするファンクションです。
また、CallGetPropertyByNameではメソッドのタイプをVbGetとしてCallByNameの引数としています。

    Dim vOutValue As CallUtilValue
    Set vOutValue = CallByNameEx(pObj, pMethodName, VbGet, vParams)

CallByNameExで可変長配列に渡す引数を選択する

コードはCallUtilモジュールのほうにありますので、ポイントだけ抜粋します。
まず、ここでログを出力しています。

    Call Logger.Start(TypeName(pObj), pMethodName, pType)
    
    '途中の処理
    
    Call Logger.Finish(TypeName(pObj), pMethodName, pType)

Loggerモジュールは以下のような内容です。第1引数はオブジェクト型でもよかったのですが、文字列で渡したい場合も考えて、あえて実行元でTypeNameを使って文字列にしてもらっています。

また、Loggerはクラスではありません。これも使い勝手を考慮して、Newする手間を省くためにモジュールとしています。
ただし、モジュールですとLoggerとモジュール名を接頭辞にしなくても動作してしまうため、ここは好みが分かれるところだと思います。

Loggerモジュール

Option Explicit
Option Private Module

Public Sub Start(pTarget As String, pProc As String, pType As VbCallType)
    Debug.Print Timestamp.Value & " START: " & pTarget & "#" & pProc & "(" & ConvertEnumToString(pType) & ")"
End Sub

Public Sub Finish(pTarget As String, pProc As String, pType As VbCallType)
    Debug.Print Timestamp.Value & " FINISH: " & pTarget & "#" & pProc & "(" & ConvertEnumToString(pType) & ")"
End Sub

Private Function ConvertEnumToString(pType As VbCallType) As String
    Select Case pType
        Case VbCallType.VbMethod
            ConvertEnumToString = "VbMethod"
        Case VbCallType.VbGet
            ConvertEnumToString = "VbGet"
        Case VbCallType.VbLet
            ConvertEnumToString = "VbLet"
        Case VbCallType.VbSet
            ConvertEnumToString = "VbSet"
        Case Else
            Debug.Print "Enum値不正"
            Debug.Assert False
    End Select
End Function

ここで使用しているTimeStampモジュールは、おなじみのGetLocalTimeのラッパーです。

TimeStampモジュール

Option Explicit
Option Private Module

Public Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type

'// 64bit版
#If VBA7 And Win64 Then
    Private Declare PtrSafe Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
'// 32bit版
#Else
    Private Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
#End If

Public Property Get Value() As String
    
    Dim vSystemTime As SYSTEMTIME
    
    '// 現在日時取得
    Call GetLocalTime(vSystemTime)
    
    '// yyyy/mm/dd hh:mm:ss.fff形式に整形
    Dim vTimeStamp As String
    vTimeStamp = Format(vSystemTime.wYear, "0000") & "/" & Format(vSystemTime.wMonth, "00") & "/" & Format(vSystemTime.wDay, "00") & " " & _
        Format(vSystemTime.wHour, "00") & ":" & Format(vSystemTime.wMinute, "00") & ":" & Format(vSystemTime.wSecond, "00") & "." & Format(vSystemTime.wMilliseconds, "000")
    
    Value = vTimeStamp
End Property

本題はここではありませんのでサクサクといきます。
パラメータの個数によってCallByNameへ渡す引数を選択します。
方法が思いつかず、10個Select-Caseで分岐しています。

    Select Case pParams.Count
        Case 0
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType))
        Case 1
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1))
        Case 2
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2))
        Case 3
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3))
        Case 4
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4))
        Case 5
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4, pParams.Args5))
        Case 6
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4, pParams.Args5, pParams.Args6))
        Case 7
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4, pParams.Args5, pParams.Args6, pParams.Args7))
        Case 8
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4, pParams.Args5, pParams.Args6, pParams.Args7, pParams.Args8))
        Case 9
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4, pParams.Args5, pParams.Args6, pParams.Args7, pParams.Args8, pParams.Args9))
        Case 10
            Set CallByNameEx = CreateValue(CallByName(pObj, pMethodName, pType, pParams.Args1, pParams.Args2, pParams.Args3, pParams.Args4, pParams.Args5, pParams.Args6, pParams.Args7, pParams.Args8, pParams.Args9, pParams.Args10))
        Case Else
            Debug.Print "引数の設定が不正です"
            Debug.Assert False
            Set CallByNameEx = Nothing
    End Select

パラメータの個数はCallUtilParameterから取得できます。

Public Function Count() As Long
    If mArgs1.IsMissing Then
        Count = 0
    ElseIf mArgs2.IsMissing Then
        Count = 1
    ElseIf mArgs3.IsMissing Then
        Count = 2
    ElseIf mArgs4.IsMissing Then
        Count = 3
    ElseIf mArgs5.IsMissing Then
        Count = 4
    ElseIf mArgs6.IsMissing Then
        Count = 5
    ElseIf mArgs7.IsMissing Then
        Count = 6
    ElseIf mArgs8.IsMissing Then
        Count = 7
    ElseIf mArgs9.IsMissing Then
        Count = 8
    ElseIf mArgs10.IsMissing Then
        Count = 9
    Else
        Debug.Print "引数が10以上設定されています。"
        Debug.Assert False
        Count = -1
    End If
End Function

CallUtilValueクラスのIsMissingメソッドでどこまで引数が設定されているかが分かります。
前述のとおり、参照不能の値をCallByNameに渡すとエラーになるためです。

あとはCallByNameを実行し、戻り値からCallUtilValueを生成しています。
ここでは一度変数に保持しないで直接引数のところでCallByNameを実行すると、オブジェクト型かどうかを判別しないで済みます。

テスト

各プロシージャのテスト

初めのサンプルでは定義済みクラスの実行でログを追加するところをお見せしました。
次は、独自定義のクラスでやってみます。

テスト対象のクラスです。

TestTargetクラス

Option Explicit

Private mValue As String

Public Sub SubNoParam()
    Debug.Print "Subでパラメータなし"
End Sub

Public Sub Sub1Param(p1 As String)
    Debug.Print "パラメータ1つ", p1
End Sub

Public Function Func2Param(p1 As String, p2 As String) As String
    Func2Param = p1 & "@" & p2
End Function

Public Function Func3Param(p1 As String, p2 As String, p3 As String) As TestTarget
    mValue = p1 & "@" & p2 & "@" & p3
    Set Func3Param = Me
End Function

Public Property Get Value() As String
    Value = mValue
End Property

Public Property Get Self() As TestTarget
    Set Self = Me
End Property

Public Property Let Value(pValue As String)
    mValue = pValue
End Property

Public Property Set Self(pObj As TestTarget)
    mValue = pObj.Value
End Property

このクラスを使用する際に、独自のCallByName拡張を使ってみます。

テストモジュール

Public Sub Test()

    Dim vTest1 As TestTarget
    Set vTest1 = New TestTarget
    
    Call CallSubByName(vTest1, "SubNoParam")
    Call CallSubByName(vTest1, "Sub1Param", "p1")
    
    Debug.Print CallFunctionByName(vTest1, "Func2Param", "p1", "p2")
    
    Dim vObj As TestTarget
    Set vObj = CallFunctionByName(vTest1, "Func3Param", "p1", "p2", "p3")
    Debug.Print CallGetPropertyByName(vObj, "Value")

    Dim vTest2 As TestTarget
    Set vTest2 = New TestTarget
    Call CallLetPropertyByName(vTest2, "Value", "prop")
    Debug.Print CallGetPropertyByName(vTest2, "Value")

    Set vObj = CallGetPropertyByName(vTest2, "Self")
    Debug.Print CallGetPropertyByName(vTest2, "Value")

    Call CallSetPropertyByName(vTest1, "Self", vTest2)
    Debug.Print CallGetPropertyByName(vTest1, "Value")
    
End Sub

実行結果は以下のようになります。

2023/09/18 15:37:09.565 START: TestTarget#SubNoParam(VbMethod)
Subでパラメータなし
2023/09/18 15:37:09.570 FINISH: TestTarget#SubNoParam(VbMethod)
2023/09/18 15:37:09.572 START: TestTarget#Sub1Param(VbMethod)
パラメータ1つ p1
2023/09/18 15:37:09.576 FINISH: TestTarget#Sub1Param(VbMethod)
2023/09/18 15:37:09.579 START: TestTarget#Func2Param(VbMethod)
2023/09/18 15:37:09.581 FINISH: TestTarget#Func2Param(VbMethod)
p1@p2
2023/09/18 15:37:09.586 START: TestTarget#Func3Param(VbMethod)
2023/09/18 15:37:09.589 FINISH: TestTarget#Func3Param(VbMethod)
2023/09/18 15:37:09.592 START: TestTarget#Value(VbGet)
2023/09/18 15:37:09.592 FINISH: TestTarget#Value(VbGet)
p1@p2@p3
2023/09/18 15:37:09.594 START: TestTarget#Value(VbLet)
2023/09/18 15:37:09.594 FINISH: TestTarget#Value(VbLet)
2023/09/18 15:37:09.595 START: TestTarget#Value(VbGet)
2023/09/18 15:37:09.596 FINISH: TestTarget#Value(VbGet)
prop
2023/09/18 15:37:09.597 START: TestTarget#Self(VbGet)
2023/09/18 15:37:09.598 FINISH: TestTarget#Self(VbGet)
2023/09/18 15:37:09.599 START: TestTarget#Value(VbGet)
2023/09/18 15:37:09.601 FINISH: TestTarget#Value(VbGet)
prop
2023/09/18 15:37:09.603 START: TestTarget#Self(VbSet)
2023/09/18 15:37:09.604 FINISH: TestTarget#Self(VbSet)
2023/09/18 15:37:09.605 START: TestTarget#Value(VbGet)
2023/09/18 15:37:09.606 FINISH: TestTarget#Value(VbGet)
prop

正しく実行できていますね。

階層構造の場合

次にクラスから別のクラスのメソッドを実行してみます。
公開されているクラスで内部のクラスを実行するところで、CallByName拡張を使うことで、START～FINISHが実行された順に階層として出力されます。

Publishクラス

Option Explicit

Public Sub Execute()
    Debug.Print "これは公開用のクラスです。これから内部でしか使わないクラスをCallSubByNameで実行します"
    Dim vIn As Internal
    Set vIn = New Internal
    Call CallSubByName(vIn, "Execute")
    Debug.Print "内部のクラスの実行が終わって戻ってきました。"
End Sub

Internalクラス

Option Explicit

Public Sub Execute()
    Debug.Print "内部でしか使わないクラスです"
End Sub

テストモジュール

Public Sub 階層構造でも正しく出力されるか()
    Dim v1 As Publish
    Set v1 = New Publish
    Call CallSubByName(v1, "Execute")
End Sub

結果を見てみます。

2023/09/18 15:42:13.414 START: Publish#Execute(VbMethod)
これは公開用のクラスです。これから内部でしか使わないクラスをCallSubByNameで実行します
2023/09/18 15:42:13.421 START: Internal#Execute(VbMethod)
内部でしか使わないクラスです
2023/09/18 15:42:13.424 FINISH: Internal#Execute(VbMethod)
内部のクラスの実行が終わって戻ってきました。
2023/09/18 15:42:13.427 FINISH: Publish#Execute(VbMethod)

きちんと出力されました。

標準モジュールでも使えます

標準モジュールでも使うことができます。

例えばこのようなプロシージャがあったとします。

Public Function 標準モジュールでも可能() As String
    標準モジュールでも可能 = "標準モジュールからの戻り値です"
End Function

標準モジュールですのでCallByNameを使うことはできませんが、これをラッピングするアダプタークラスを用意します。

Adapterクラス

Option Explicit

Public Function 標準モジュールラッピング() As String
    標準モジュールラッピング = 標準モジュールでも可能
End Function

このアダプタークラスを使ってあげれば標準モジュールでも実行できます。

Public Sub TestFor標準モジュール()
    Dim vAdapter As Adapter
    Set vAdapter = New Adapter
    Debug.Print CallFunctionByName(vAdapter, "標準モジュールラッピング")
End Sub

結果は以下の通り。

2023/09/18 19:32:57.490 START: Adapter#標準モジュールラッピング(VbMethod)
2023/09/18 19:32:57.493 FINISH: Adapter#標準モジュールラッピング(VbMethod)
標準モジュールからの戻り値です

使うのは面倒ではないのか？

これまで色々な使い方を見てきました。
ただ、文法が結構異なるように見えますので、使うの面倒そうって思っていませんか？

大丈夫です。次ぐ使えるようになります。

Step1：普通に記述する

例えば、一番初めに紹介した、ブック名を出力するものを考えてみます。
通常の記述は、

Debug.Print ThisWorkbook.Name

こう記述します。

Step2：インテリセンスで表示する

ThisWorkbookの前で、Callくらいまで打ち込んでインテリセンス（Ctrl+Space）でCallByName拡張を表示します。

あとは使用する対象を選択します。すると勝手にセミコロンが入ります。

Public Sub Testtest()
    Debug.Print CallGetPropertyByName; ThisWorkbook.Name
End Sub

Step3：引数を修正する

これでは動作しないため、引数を修正します。
セミコロンをカッコ初めにして、
第1引数はオブジェクトなので、ThisWorkbookを使います。
第2引数はメソッド名なので、Nameをダブルクォーテーションで囲んで、"Name"にします。
さらに引数がある場合は、使っていた引数をそのまま渡せばよいだけです。
最後にカッコを閉じます。

Public Sub Testtest()
    Debug.Print CallGetPropertyByName(ThisWorkbook, "Name")
End Sub

このように実行順序に引数が並んでいるため、比較的簡単に利用できます。

できないこと

これはCallByNameでもできませんが、ThisWorkbook.WorkSheets("Sheet1").Nameのようなコロンを続けて実行するものは1回の実行では出来ません。
例でもある通り、

Debug.Print CallGetPropertyByName(CallGetPropertyByName(ThisWorkbook, "WorkSheets", "Sheet1"), "Name")

といった形で2回にする必要があります。

ただ、これは定義済みオブジェクトを使用するときは多用しますが、自分で作成したクラスではあまり使用しません。
デルメルの法則に従っていれば、あまりそういうコードは記載しないでしょう。

結局、課題は解決できたのか

最後に課題の解決がどのようになされたのか振り返ってみましょう。

プロシージャ名を変更したらログ出力も修正が必要
⇒引数でメソッド名を渡すので、間違っていたら動作しないため、正しいことが保証される
ログ出力し忘れても気が付かない、または面倒であえてやらなくなる
⇒CallByNameよりも簡単に記述でき、記述順の変更もないため修正は容易
プロシージャなどの小さいレベルでも実装するのか・しないのか判断に迷う
⇒あとからいつでもログ出力を入れ込めるので、出力したくなったら入れるでOK

解決できています。
作ったものを破壊せずに後からログを導入できるのはとてもいいことです。
皆様もぜひ使ってみてください。

開発経緯

解決の糸口はCallByName

利用する側のコード

CallUtilモジュール

シグニチャ

パラメータ管理クラス

CallUtilValueクラスで値の状態を管理する

CallByNameExでCallByNameをラッピングする

CallByNameExで可変長配列に渡す引数を選択する

テスト

各プロシージャのテスト

階層構造の場合

標準モジュールでも使えます

使うのは面倒ではないのか？

Step1：普通に記述する

Step2：インテリセンスで表示する

Step3：引数を修正する

できないこと

結局、課題は解決できたのか

Discussion