このアーカイブは同期化されません。 mixi の日記が更新されても、このアーカイブには反映されません。
Solve マクロにクラスの皮を被せて、
イベントを受け取れるように、
SolveAction クラスを作成しよう。
名前は重要でないので適当につけたが、
SolveMacro クラスとかでもいいかも。
実際の Solve マクロは、
F8 ダイアログから呼び出すためだけのために残しておき、
実装はごっそり SolveAction に移行しよう。
Public Sub Solve()
Dim oAction As SolveAction
Set oAction = New SolveAction
Call oAction.Execute
End Sub
SolveAction のインスタンスを作成し、
Execute を呼んで実行するだけ。いわば丸投げ状態だ。
SolveAction クラスの方には、
引数なしの Execute メソッドを定義し、
それがマクロの実行時に呼び出されることになる。
SolveAction で必要なフィールドを考えよう。
SolveAction はクラスなので、
WithEvents をつけたフィールド変数が定義できる。
まあ、解答クラスと、セル範囲くらいだろうか。
' 解答クラスのイベントを受け取る
Private WithEvents m_oAnswer As PuzzleAnswer
' 解答欄の領域
Private m_oAnswerRange As Range
そして、Execute メソッド。
基本的には Solve マクロに書いた内容を
そのまま持ってくるだけだ。
Public Sub Execute()
Dim oLoader As PuzzleSheetLoader
Dim oSolver As MixiPuzzleSolver
Dim oAnswer As PuzzleAnswer
Dim x As Long
Dim y As Long
' 解答欄の領域を記憶する
Set m_oAnswerRange = Selection
' 問題を読み込み、
Set oLoader = New PuzzleSheetLoader
Call oLoader.Construct(m_oAnswerRange)
' ソルバに渡す
Set oSolver = New MixiPuzzleSolver
Call oSolver.Construct(oLoader)
' 解答クラスに接続する
Set m_oAnswer = oSolver.Answer
' 解く
Call oSolver.Solve
End Sub
まず解答欄の領域をフィールド変数に格納しておく。
Selection は現在の選択範囲だから、
ユーザやプログラムによって変更されると困る。
因みに、Selection は、選択範囲が変わるごとに、
新しい Range インスタンスが割り当てられるので、
Selection をそのまま記憶しておいて構わない。
Range クラスは「セル範囲」に関しては不変なのである。
そして、WithEvents 付きのフィールド m_oAnswer に、
解答範囲クラスのインスタンスを代入する。
これによって、クラスが「イベント通知に接続」され、
m_oAnswer によるイベントを受け取れるようになるのだ。
大きな違いは、Call oSolver.Solve の後に、
Answer を参照していないことだ。
解答状況はリアルタイムで通知されるので、
そちらで Excel のセルに随時反映させる。
では、イベントの処理を書こう。
m_oAnswer の Changed イベントだ。
' 答えが出たら該当セルを更新
Private Sub m_oAnswer_Changed( _
ByVal x As Long, ByVal y As Long, _
ByVal NewState As CellStateConstants)
Dim c As Range
' 該当セルを取得
Set c = m_oAnswerRange(y + 1, x + 1)
' セルを選択してカーソルを移動
Call c.Select
' 値を更新
Select Case NewState
Case CELL_CHECKED:
c.Value = "×"
Case CELL_FILLED:
c.Value = "■"
Case Else:
c.Value = Empty
End Select
' 速すぎるので少し待つ
Call Wait(0.1)
End Sub
m_oAnswerRange に解答欄の範囲が格納されているので、
x, y を元にセルの位置を割り出す。
Select でカーソルを移動させ、目立たせる。
そして解答によってセルの値を書き換えるのだ。
Excel VBA といえども処理は非常に速いので、
セルの更新のあと、100 ミリ秒くらいの間を持たせて、
ゆっくり鑑賞できるようにする。
Private Sub Wait(ByVal Seconds As Single)
Dim s As Single
s = Timer + Seconds
While s > Timer
DoEvents
Wend
End Sub
ちょっと手抜きだけどまあいいか。
日付を跨ぐと無限ループになるので注意。
さて、実行してみよう。
セルが段々と塗り潰されている様子が目に見える。