VBAの「コンストラクタに引数渡せない」問題
VBAの「コンストラクタに引数を渡せない」問題
VBAでクラスモジュールを使い始めたときに必ずぶち当たるのが、
なんでコンストラクタに引数が渡せねえんだよ！
この金髪豚野郎!!!!!!!!!
問題だろう。（個人の感想です）
これは本当に不便な話で、「VBAのイマイチなところ大特集」でもやったら、かなり上位に来る項目だと思う。
よくあるやり方は、別途initメソッドを持たせておいて、Newしたら必ずセットでinitメソッドも実行する、というもの。これは自分でもよくやる。
initメソッド未実行ならば、一切メソッドの実行もプロパティの参照もさせないようにしておくことで、まあそこそこの信頼性は確保できる。
こんな感じ。まあ、このときはinitメソッド実行済みチェックが不完全ですなあ。ははは。
達人の方なんかだと
VBA 自分と同じクラスの新規オブジェクトを返すメソッドを作ってコレクションにスマートに代入する
みたいに、すげえやり方で実装していたりする。
私はなにぶんにも素人なので、もっとアホみたいな対応策を考えてみた。
インスタンス作成用Function
CreateObject関数みたいな感じのFunctionを作って、Newさせずにインスタンスを得る、という方向で考えた。
リスト１ 標準モジュールの宣言セクション
まずは、準備として標準モジュールの宣言セクションに次のコードを書く。
Public Enum RacerClass SS = 0 S1 S2 S3 A1 A2 A3 A4 B1 B2 End Enum Public isInstantiated As Boolean
列挙体とPublic変数の宣言をしているだけ。先に書くと、Public変数を使う、という点が今回の対応のイマイチなところだという自覚はあるｗ
リスト２ クラスモジュール
クラスモジュールを挿入し、オブジェクト名を「SampleRacer」とした。
Option Explicit Private Const ERROR_MESSAGE_10001 As String = _ "SampleRacerクラスを直接Newすることはできません。" & vbCrLf & _ "createSampleRacerObjectメソッドを使用してインスタンス化してください。" Private Const ERROR_MESSAGE_10002 As String = _ "initメソッドを複数回実行することはできません。" Private registeredName_ As String Private racingClass_ As RacerClass Private graduatedTerm_ As Integer Private isInitialized As Boolean Public Property Get registeredName() As String registeredName = registeredName_ End Property Public Property Get racingClass() As String Select Case racingClass_ Case RacerClass.SS racingClass = "Ｓ級Ｓ班" Case RacerClass.S1 racingClass = "Ｓ級１班" Case RacerClass.S2 racingClass = "Ｓ級２班" Case RacerClass.S3 racingClass = "Ｓ級３班" Case RacerClass.A1 racingClass = "Ａ級１班" Case RacerClass.A2 racingClass = "Ａ級２班" Case RacerClass.A3 racingClass = "Ａ級３班" Case RacerClass.A4 racingClass = "Ａ級４班" Case RacerClass.B1 racingClass = "Ｂ級１班" Case RacerClass.B2 racingClass = "Ｂ級２班" End Select End Property Public Property Get graduatedTerm() As Integer graduatedTerm = graduatedTerm_ End Property Private Sub Class_Initialize() '……(1)' If Not isInstantiated Then _ Err.Raise Number:=10001, _ Description:=ERROR_MESSAGE_10001 isInstantiated = False End Sub Public Sub init(ByVal racerName As String, _ ByVal racingClass As RacerClass, _ ByVal graduatedTerm As Integer) '……(2)' If isInitialized Then Err.Raise Number:=10002, _ Description:=ERROR_MESSAGE_10002 Call setRacer(racerName, racingClass, graduatedTerm) isInitialized = True End Sub Public Sub setRacer(ByVal racerName As String, _ ByVal racingClass As RacerClass, _ ByVal graduatedTerm As Integer) Call setName(racerName) Call setClass(racingClass) Call setTerm(graduatedTerm) End Sub Public Sub setName(ByVal racerName As String) registeredName_ = racerName End Sub Public Sub setClass(ByVal racingClass As RacerClass) racingClass_ = racingClass End Sub Public Sub setTerm(ByVal graduatedTerm As Integer) graduatedTerm_ = graduatedTerm End Sub Public Sub showMyself() Debug.Print "ハロ～♪ ＣＱ、ＣＱ、私は" & Me.racingClass & "。" Debug.Print graduatedTerm_ & "期の" & registeredName & "で～す！" End Sub
サンプルだから凝らなくてもいいのに、ムダにタテ長になってしまった。いつものことながら申しわけない。
ごく普通のクラスモジュールだが、(1)の
Private Sub Class_Initialize()
If Not isInstantiated Then _
Err.Raise Number:=10001, _
Description:=ERROR_MESSAGE_10001
isInstantiated = False
End Sub
では、普段ほぼ何の役にも立たないClass_Initializedプロシージャに
If Not isInstantiated Then
という条件式を書いている。isInstantiatedという変数については後述するが、普通にNewでインスタンス化しようとすると、ここでエラーを吐いて弾き返す、という仕組みにした。
最後に
isInstantiated = False
でisInitializedをFalseに戻す。こうしておかないと、次から普通にNewできてしまうｗ Function作った意味がなくなるので、要注意。
あと、(2)の
Public Sub init(ByVal racerName As String, _
ByVal racingClass As RacerClass, _
ByVal graduatedTerm As Integer)
If isInitialized Then Err.Raise Number:=10002, _
Description:=ERROR_MESSAGE_10002
Call setRacer(racerName, racingClass, graduatedTerm)
isInitialized = True
End Sub
が実質的なコンストラクタ。isInitializedフラグを用いることで複数回実行されることを防ぐ。
リスト３ 標準モジュール
んで、コチラがインスタンス生成用のFunction。
Public Function createSampleRacerObject( _
ByVal racerName As String, _
ByVal racingClass As RacerClass, _
ByVal graduatedTerm As Integer) As SampleRacer
isInstantiated = True '……(1)'
Dim smplRacer As New SampleRacer '……(2)'
smplRacer.init racerName, racingClass, graduatedTerm '……(3)'
Set createSampleRacerObject = smplRacer '……(4)'
End Function
シンプルなコードなので説明するまでもないけれど、一応。
まず、(1)の
isInstantiated = True
でisInstantiatedをTrueにしておく。こうすることで、次に(2)でNewしたときにClass_Initializedで弾き返されることを防ぐ。
(2)の
Dim smplRacer As New SampleRacer
でインスタンス化し、
(3)の
smplRacer.init racerName, racingClass, graduatedTerm
で引数を渡して初期化。
あとは、(4)の
Set createSampleRacerObject = smplRacer
でインスタンスを呼び出し元に返す。
使用実験
次のコードでSampleRacerクラスを使ってみる。
リスト４ 標準モジュール
Public Sub testSampleRacerClass()
Dim sr1 As SampleRacer
Set sr1 = New SampleRacer '……(*)'
Set sr1 = createSampleRacerObject("中野浩一", S1, 35) '……(1)'
With sr1
.showMyself '……(2)'
.setRacer "左京源皇", A3, 72 '……(3)'
.showMyself
.setRacer "鶴岡篤人", B2, 52 '……(4)'
.showMyself
End With
Dim sr2 As SampleRacer
Set sr2 = createSampleRacerObject("吉岡稔真", S1, 65) '……(5)'
sr2.showMyself
End Sub
まず、このまま実行してみると、一見何の問題もなさそうな(*)の
Set sr1 = New SampleRacer
のところで、
エラーになる。狙い通り。
実行時は(*)をコメントアウトします。
(1)の
Set sr1 = createSampleRacerObject("中野浩一", S1, 35)
でcreateSampleRacerObjectに引数を３つ渡してインスタンス化。
(2)の
sr1.showMyself
でshowMyselfメソッドを実行。
(3)からの２行
sr1.setRacer "左京源皇", A3, 72 sr1.showMyself
では、setRacerメソッドでパラメータを書き換えた後、showMyselfメソッドを実行。
(3)からの２行
sr1.setRacer "鶴岡篤人", B2, 52 sr1.showMyself
も(2)と同じ。
(5)からの２行
Set sr2 = createSampleRacerObject("吉岡稔真", S1, 65)
sr2.showMyself
では、別のインスタンスを生成してshowMyselfメソッドを実行。
実行結果
無事、意図したとおりの結果となった。
おわりに
今にして思えば、別にNewを禁止することはなかったな。
引数が必要なければ普通にNew、引数が必要だったらFunction経由、という風に使い分けたらいいだけだし。
そうすれば、グローバル変数isInstantiatedも必要なくなるなあ。
インターフェイスを使うやり方も含め、もうちょっと研究してみる余地はありそう。
