VBA クラスモジュールのデフォルトプロパティをマクロで設定する

以前、クラスモジュールをエクスポートしてテキストエディタで編集することでデフォルトプロパティを変更できるという記事を書いた
thom.hateblo.jp

しかし、わざわざエクスポートして書き換えるというのも面倒くさい。

VBAはテキストも扱えるので、どうせならエクスポートしてデフォルトプロパティのAttribute(属性)追加してインポートさせるところまで自動化してしまおうというのが今回のネタ。

どうやるかというと、まずクラスモジュールのデフォルトプロパティにしたいプロシージャにコメントで目印を付ける。
今回は「'=Default Property」というコメントを目印として属性を追加するコードを書いた。

プロパティを追加するターゲットとして、OperatableNumberというクラスを作成した。
コードは以下のとおり。Numberプロパティに目印のコメントを入れてある。

Private PNumber As Long
Public Unit As String

Private Sub Class_Initialize()
    PNumber = 0
End Sub

Property Get Number() As Long
    '=Default Property
    Number = PNumber
End Property

Public Sub Clear()
    Call Class_Initialize
End Sub

Public Sub Add(Optional x As Variant = 1)
    PNumber = PNumber + x
End Sub

Public Sub CountUp()
    Me.Add 1
End Sub

Property Get WithUnit()
    WithUnit = Format(Number, "#,#") & Unit
End Property

そして上記のクラスを加工するコードがこちら。
※実行には以下3点の参照設定と、マクロのセキュリティ設定でVBA プロジェクト オブジェクト モデルへのアクセスを信頼するのチェックが必要

• Microsoft Visual Basic for Applications Extensibility 5.3
• Microsoft Scripting Runtime
• Microsoft VBScript Regular Expressions 5.5

Sub Sample()
    Call DefaultProperty( _
        "OperatableNumber", _
        "C:\Users\thom\ExportedClassFiles\", _
        ThisWorkbook)
End Sub

Sub DefaultProperty( _
        クラス名 As String, _
        出力フォルダ As String, _
        対象ブック As Workbook, _
        Optional クラスの変更前にバックアップを作成する As Boolean = True, _
        Optional エクスポートした一時ファイルを削除する As Boolean = True)
    
    Dim VBC As VBComponent
    Set VBC = 対象ブック.VBProject.VBComponents(クラス名)
    VBC.Export (出力フォルダ & クラス名 & ".cls")
    Dim FSO As New FileSystemObject
    Dim TS As TextStream
    
    Set TS = FSO.OpenTextFile(出力フォルダ & クラス名 & ".cls", ForReading)
    Dim テキスト As String
    テキスト = TS.ReadAll
    TS.Close
    
    Dim RE As New RegExp
    RE.Pattern = "Attribute .*\.VB_UserMemId = 0\r?\n"
    RE.Global = True
    RE.MultiLine = True
    テキスト = RE.Replace(テキスト, "")
    テキスト = Replace(テキスト, "'=Default Property", "Attribute Default.VB_UserMemId = 0" & vbCrLf & "    '=Default Property")
    
    Set TS = FSO.OpenTextFile(出力フォルダ & クラス名 & ".cls", ForWriting)
    TS.Write テキスト
    TS.Close
    
    If クラスの変更前にバックアップを作成する Then
        VBC.Name = VBC.Name & Format(Now, "_yyyymmddhhMMss")
    Else
        対象ブック.VBProject.VBComponents.Remove VBC
    End If
    対象ブック.VBProject.VBComponents.Import (出力フォルダ & クラス名 & ".cls")
    
    If エクスポートした一時ファイルを削除する Then
        FSO.DeleteFile (出力フォルダ & クラス名 & ".cls")
    End If
End Sub

Sampleプロシージャの1つ目の引数はターゲットのクラス名、2つ目は一時的にクラスをエクスポートする先(書き込み権限のあるフォルダを指定する。)、3つ目はクラスがあるワークブックを指定する。

    Call DefaultProperty( _
        "OperatableNumber", _
        "C:\Users\thom\ExportedClassFiles\", _
        ThisWorkbook)

オプションの引数2つはDefaultPropertyプロシージャを参照。

これらもUserFormを作成して選択させられると楽だが、面倒なので今回はやってない。とりあえず使えるから良い。

コード中で正規表現を使用しているところがある。

    RE.Pattern = "Attribute .*\.VB_UserMemId = 0\r?\n"

これはデフォルトプロパティを途中で買えたいような場合もあるので、別のプロパティがデフォルトプロパティになっている場合に一旦削除するための措置で、正規表現で削除するためのコードである。

今回たまたま気付いたのだが、エクスポートしたクラスに
「Attribute Default.VB_UserMemId = 0」と書いても、インポートするとDefaultの部分がプロパティ名に置き換わってしまうようで、例えばNumberプロパティに書いてインポートしたもの再度エクスポートしてみたら
「Attribute Number.VB_UserMemId = 0」となっていた。

要はDefaultの部分の初期値はなんでも良いみたいで、
「Attribute A.VB_UserMemId = 0」でも、
「Attribute あ.VB_UserMemId = 0」でも、取り込まれてしまえば同じである。ちなみに前回の記事では海外サイトのコードを参考にしたため、Valueとしている。

この可変性はVBAの標準機能で扱うのは少々厄介なので、正規表現を用いた。

さて、実行すると一見何も変化がないが、OperatableNumberクラスのNumberプロパティに見えないコードが埋め込まれてデフォルトプロパティになっている。

以下のコードで正しく実行されるか試してみると、

Sub デフォルトプロパティサンプル()
    Dim x As New OperatableNumber
    x.Unit = "円"
    x.Add 1000
    MsgBox x
End Sub

通常MsgBox x.Numberと書くところを、xだけで1000と表示される。

次にOperatableNumberのNumberプロパティから'=Default Propertyのコメントを消し、WithUnitプロパティに付与してみる。

Property Get Number() As Long
    Number = PNumber
End Property

Property Get WithUnit()
    '=Default Property
    WithUnit = Format(Number, "#,#") & Unit
End Property

そして、Sampleマクロでデフォルトプロパティの付け替えを行った後、再度以下のコードを実行すると、

Sub デフォルトプロパティサンプル()
    Dim x As New OperatableNumber
    x.Unit = "円"
    x.Add 1000
    MsgBox x
End Sub

1,000円と表示される。