VBAでインターフェースを使って引数付きのコンストラクタを実現する

元ネタはこちら

参考サイト

愚者の経験 – コンストラクタで引数を入れたい
https://foolexp.wordpress.com/2012/02/21/%E3%82%B3%E3%83%B3%E3%82%B9%E3%83%88%E3%83%A9%E3%82%AF%E3%82%BF%E3%81%A7%E5%BC%95%E6%95%B0%E3%82%92%E5%85%A5%E3%82%8C%E3%81%9F%E3%81%84/

愚者の経験 – クラスモジュールにも「規定のインスタンス」
https://foolexp.wordpress.com/2012/02/24/%E3%82%AF%E3%83%A9%E3%82%B9%E3%83%A2%E3%82%B8%E3%83%A5%E3%83%BC%E3%83%AB%E3%81%AB%E3%82%82%E3%80%8C%E6%97%A2%E5%AE%9A%E3%81%AE%E3%82%A4%E3%83%B3%E3%82%B9%E3%82%BF%E3%83%B3%E3%82%B9%E3%80%8D/

t-hom’s diary – VBAでインターフェースを使って引数付きのコンストラクタを実現する。
https://thom.hateblo.jp/entry/2015/02/15/012503

VBAでインターフェースを使って引数付きのコンストラクタを実現するやり方を模索していたのですが、かなり強引な方法ですが、ほぼやりたいことができたのでやり方を公開します。t-homさんも言っていますが疑似引数付コンストラクタです。(裏技的な感じがハンパないです・・・。)

結果どうなったか

この記事はなかったことに orz


以下、記述にて疑似コンストラクタの記述ができるようになりました。IConstructor クラスを追加するだけで、標準モジュールを不要にしました。

    Set sb = IConstructor.Instancing(New StringBuilder, 1000)


IConstructorは初期のインスタンスをあたえて、そのままクラス名で呼べるようにします。New したクラスと引数を指定します。引数の指定は好みですが、2つのInstancingメソッドでの引数の受け渡しでParam Array が使いづらいので複数指定の時にはArrayで渡すようにしました。

Sub Test()

    Dim sb As StringBuilder
    
    'コンストラクタで複数の引数を渡す場合はArrayで渡す。
    'Set sb = IConstructor.Instancing(New StringBuilder, Array(1000, 2000))
    
    Set sb = IConstructor.Instancing(New StringBuilder, 1000)
    
    Dim i As Long
    
    For i = 1 To 1000
    
        sb.Append CStr(i)
    
    Next
    
    Debug.Print sb.ToString

End Sub

以下、実現方法です。

Interfaceクラスの説明

IConstructor というInterfece クラスを1つ作成します。


キモは「Attribute VB_PredeclaredId = True」でクラスに規定のインスタンスを与えることです。
規定のインスタンスとはクラスをNewしなくても、インスタンスが1つ生成され、クラス名でメンバにアクセスが可能になります。他言語でいう Static なクラスです。


このプロパティはプロパティウィンドウでは書き換えられないので一度、EXPORTした後、値をTrueに変更、インポートします。
本来のこのクラスは Interface に使用するので、Instancing メソッドの中身を書く必要はありません。しかし、このクラス自体は普通のクラス扱い(呼び出し先はImplementsを書くけど)
なので、コンストラクタに引数を渡すヘルパー関数として利用します。参考にしたサイトでは標準モジュールを利用していましたのでその改善になります。


以下、Export した状態のクラス。8行目を True にする。

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "IConstructor"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'---------------------------------------------------
' コンストラクタ呼び出し
'---------------------------------------------------
Public Function Instancing(ClassObject As Object, ByVal Args As Variant) As Object
    
    Dim c As IConstructor
    
    Set c = ClassObject
    
    '引数が1つの場合Arrayにする必要がない。コンストラクタ内でIsArrayするのが面倒なので常に Array する。
    If Not IsArray(Args) Then
        Args = Array(Args)
    End If
    
    Set Instancing = c.Instancing(ClassObject, Args)

End Function

コンストラクタを作成したクラスの説明


こちらはサンプルのクラスとして、以前作っていた StringBuilder クラスですが、これにInterfaceを用いて引数付のコンストラクタを作成します。
「Implements IConstructor」を記述し、作成される「IConstructor_Instancing」メソッドの中に初期化の内容を記述します。

'-----------------------------------------------------------------------------------------------------
' 文字列連結クラス
'-----------------------------------------------------------------------------------------------------
Option Explicit
Implements IConstructor

Private mstrBuf() As String
Private mlngCount As Long
Private mlngLength As Long
Private Const C_INIT_COUNT As Long = 25
Private mlngInitCount As Long
'------------------------------------------------------
' 初期化
'------------------------------------------------------
Private Sub Class_Initialize()
    mlngInitCount = C_INIT_COUNT
    Me.Clear
End Sub
'------------------------------------------------------
' 終了
'------------------------------------------------------
Private Sub Class_Terminate()
    Erase mstrBuf
End Sub
'------------------------------------------------------
' コンストラクタ 初期配列サイズの変更
'------------------------------------------------------
Private Function IConstructor_Instancing(ClassObject As Object, ByVal Args As Variant) As Object

    If UBound(Args) <> -1 Then
        mlngInitCount = Args(0)
        Me.Clear
    End If
    
    Set IConstructor_Instancing = ClassObject
    
End Function
'------------------------------------------------------
' クリア
'------------------------------------------------------
Public Sub Clear()
    
    Erase mstrBuf
    ReDim Preserve mstrBuf(0 To mlngInitCount)
    
    mlngCount = 0
    mlngLength = 0

End Sub
'------------------------------------------------------
' 追加
'------------------------------------------------------
Function Append(ByVal s As String)

    '配列にセット
    If mlngCount > UBound(mstrBuf) Then
        ReDim Preserve mstrBuf(0 To mlngCount)
    End If
    mstrBuf(mlngCount) = s
    
    '文字数をカウント
    mlngLength = mlngLength + Len(s)
    
    '要素数+1
    mlngCount = mlngCount + 1

End Function
'------------------------------------------------------
' 文字列変換
'------------------------------------------------------
Function ToString()

    Call resize
    ToString = Join(mstrBuf, "")

End Function
'------------------------------------------------------
' 文字列変換(JOIN)
'------------------------------------------------------
Function ToJoin(ByVal strDelimiter As String)
    
    Call resize
    ToJoin = Join(mstrBuf, strDelimiter)

End Function
'------------------------------------------------------
' 文字列変換前のリサイズ
'------------------------------------------------------
Private Sub resize()
    
    Select Case mlngCount
        Case Is <= 0
            ReDim Preserve mstrBuf(0 To 0)
        Case Is < mlngInitCount
            ReDim Preserve mstrBuf(0 To mlngCount - 1)
    End Select

End Sub
'------------------------------------------------------
' 文字数
'------------------------------------------------------
Public Property Get Length() As Long
    Length = mlngLength
End Property
'------------------------------------------------------
' 置換
'------------------------------------------------------
Public Sub Replace(ByVal strFind As String, ByVal strReplace As String)

    Dim strBuf As String

    strBuf = Me.ToString
    
    Me.Clear
    
    Me.Append VBA.Replace(strBuf, strFind, strReplace)

End Sub


呼び出し側と呼び出されたコンストラクタの引数が一致しているため(そもそもそれがInterfaceの役割ですが)イイ感じにリンクできている感じです。
もうちょっと Param Array 同士の受け渡しがうまくいけばなぁ~。という感じ。

サンプルダウンロード(constructor.xlsm)

ABOUTこの記事をかいた人

はてなブックマークで驚愕の1600越えを記録した伝説が今明らかに! エクセル方眼紙 四天王の1人(ほぼ最弱)窓の杜大賞2014 大賞受賞! Excelを便利にする250以上の機能を体系化したアドインはこちらです。