RubberDuckでテスト駆動開発したXLSMの配布時にコンパイラ動作を簡単切替

なぜ切り替えるのか

VBAでテストフレームワークを使用しているとき、
ライブラリの参照に関して、
配布時に起きる問題と、開発時に起きる問題の、
２つの問題を同時に解決したいからです。

しばしば発生する、
「参照設定とCreateObject( )」問題です。
どちらかしか解決できないため、
面倒な作業が待っています。
典型的なトレードオフですね。

配布時に起きる問題

RubberDuck というテストフレームワークを利用して開発した後、
ユーザーに配布するときにはExcelファイル単体で配布したいです。

ところがそのままでは、ライブラリ参照が原因でエラーが発生してしまいます。
「RubberDuck AddIn」ライブラリは、以下のディレクトリにあります。

%Programdata%/Rubberduck/RubberDuck.x32.tlb

RubberDuckのインストーラーによって、
ここにライブラリがインストールされます。

開発時に起きる問題

上記の配布時のエラーを防ぐために、
下記の記法を使うとインテリセンスが効かないため不便です。

Private Fakes As Object
Set Fakes = CreateObject("Rubberduck.FakesProvider")

作戦の概略

表題のように切り替える必要がある場合、
定数を一つ切り替えるだけで、
簡単に動作を切り替えることが出来ます。

そこで、両方の記法で記しておいて、
「配布時に簡単に切り替えよう！」というわけです。

これにより、参照設定を行いインテリセンスが効く状態を保ち、
配布用のコードを共存させることが出来ます。

コンパイラディレクティブ

「コンパイラディレクティブ」という構文を使うと切り替えを実現できます。
もしくは、別名「プリプロセッサディレクティブ」とも言うらしいです。

Microsoftのリファレンスでは、コンパイラディレクティブと呼んでいるので、以後は統一して書きます。

意味

ディレクティブとは「direct」に接尾辞「ive」が付いているので、
「指示する」＋「…の性質をもつ（物、人）」で「指示する性質を持つもの」みたいな意味なはずです。

全体として、「コンパイラに指示する性質を持つ構文＝コンパイラディレクティブ」と考えて良さそうです。

構文

VBAのコンパイラディレクティブは２種類だけです。

このうち、#Constで始まる構文を使うと「コンパイラ定数」を定義できます。

ただし、これによって定義される定数のスコープはモジュールレベルです。

もう１つの、#Ifで始まる構文を組み合わせて、

「条件付きコンパイラコンストラクト」を構築します。

コンストラクトは構造という意味らしいです。

このとき、#Const構文で定義する定数の他に、既定で使える定数があります。

これらのスコープはグローバルなので、どこでも使用できます。

実践

実践

なんのための仕様？

`### なんのための仕様？

これは、ある意味では有用な仕組みかもしれません。

しかし、RubberDuckでテスト駆動開発を行うときには不便です。
RubberDuckでの開発には、RubberDuck.AssertとRubberDuck.Fakesの２つを使います。

まじかよ裏切られた

RubberDuckコマンドを使用してテストモジュールを自動生成すると、
各テストモジュールでそれぞれにオブジェクトを宣言する記述になっています。
そのため、各テストモジュールに#Const構文が必要です。

これでは、せっかく期待したのに裏切られた気分です。
配布時には、モジュールごとに定数を書き換えなければなりません。

解決方法

共通モジュールの作成

テスト用の共通クラスを１つ作成します。
この中でRubberDuck.AssertとRubberDuck.Fakesの２つを定義します。

他のテストモジュールからは、
この共通クラスをインスタンス化して呼び出すようにします。

切り替え方法

これならテストモジュールがいくつあっても、
デバッグ時・配布時の切り替えは１か所で済みます。

具体的には、
#Const canRef = Trueと#Const canRef = False

の切り替えです。

めでたしめでたし。

テスト用共通モジュール

TestController.cls

Option Explicit
Option Private Module

'@TestModule
'@Folder("Tests")

# Const canRef = True

# If canRef Then

    Public Assert As New Rubberduck.AssertClass
    Public Fakes As New Rubberduck.FakesProvider
# Else

    Public Assert As Object
    Public Fakes As Object
# End If

'@ModuleInitialize
Public Sub ModuleInitialize()
    'this method runs once per module.
    #If canRef Then

        Set Assert = New Rubberduck.AssertClass
        Set Fakes = New Rubberduck.FakesProvider
    #Else

        Set Assert = CreateObject("Rubberduck.AssertClass")
        Set Fakes = CreateObject("Rubberduck.FakesProvider")
    #End If

End Sub

'@ModuleCleanup
Public Sub ModuleCleanup()
    'this method runs once per module.
    Set Assert = Nothing
    Set Fakes = Nothing
End Sub

テストモジュール

Test_SampleModule.bas

Option Explicit
Option Private Module

'@TestModule
'@Folder("Tests")

Private TestCon As New TestController

'@ModuleInitialize
Private Sub ModuleInitialize()
    'this method runs once per module.
    TestCon.ModuleInitialize
End Sub

'@ModuleCleanup
Private Sub ModuleCleanup()
    'this method runs once per module.
    TestCon.ModuleCleanup
End Sub

'@TestInitialize
Private Sub TestInitialize()
    'This method runs before every test in the module..
End Sub

'@TestCleanup
Private Sub TestCleanup()
    'this method runs after every test in the module.
End Sub

'@TestMethod("Small")
Private Sub TestbasePoint()
    On Error GoTo TestFail
    'Arrange:
    Dim mypoint As New basePoint
    'Act:
    mypoint.X = 1
    mypoint.Y = 1
    mypoint.Z = 1

    'Assert:
    TestCon.Assert.Succeed

TestExit:
    Exit Sub
TestFail:
    TestCon.Assert.fail "Test raised an error: #" & Err.Number & " - " & Err.Description

End Sub

テスト対象のクラスモジュール

basePoint.cls

'@Folder("MainModule")
' XYZの３次元ベクトルを表すクラス
Option Explicit

Private myX As Double
Private myY As Double
Private myZ As Double

Private Sub Class_Initialize()
    myX = 0
    myY = 0
    myZ = 0
End Sub

Public Property Get X() As Double
    X = myX
End Property

Public Property Get Y() As Double
    Y = myY
End Property

Public Property Get Z() As Double
    Z = myZ
End Property

Public Property Let X(ByVal inputValue As Double)
    myX = inputValue
End Property
Public Property Let Y(ByVal inputValue As Double)
    myY = inputValue
End Property
Public Property Let Z(ByVal inputValue As Double)
    myZ = inputValue
End Property

Public Function CreatePoint(inputX As Double, inputY As Double, inputZ As Double) As basePoint
    Dim ans As New basePoint
    ans.init inputX, inputY, inputZ
    CreatePoint = ans
End Function

Public Sub init(inputX As Double, inputY As Double, inputZ As Double)
    Me.X = inputX
    Me.Y = inputY
    Me.Z = inputZ
End Sub

まとめ

「あなたにとって、テクノロジーとは？」
「トレードオフの限界を突破するためにあるもの。」

参考文献

RubberDuck | 公式ページ
条件付きコンパイルについて | Microsoft Docs

Excelsior!