VBAで入れ替えゲームを作りましょう。
ルールは以下の通りとします。
・左右に3つずつ、同じ種類のカードが並んでいる
・空白のカードと模様の入ったカードを交換することにより左右の配置を
入れ替えることができればクリア
・カードは1つまでなら跳び越すことができる
下準備
まずは『IMG』シートを作成し、カードの絵柄を図のように作成します。
今回は幅5×高さ6のセルを使ってピンクと青の星マークを作りましたが、星の上部に番号を入力しておきます。
そして2つの星の右側に空白のカード用の枠を作り、同じ位置に番号を入力します。
次に空の『MAIN』シートを作成します。ここに『IMG』シートのカードをコピーして並べていくので、
列幅を同じサイズに調整しておきます。
共通定義
始めに新規のモジュールを作成し、『Option Base 1』と記述します。
通常配列の要素数は0から始まりますが、この設定により要素数が1からになります。
そして要素数7の配列『Stars』を定義します。
初期配置
それでは、新規のプロシージャ『MAIN』を作成してコードを書いていきましょう。
<コード①>
Sub MAIN() '変数定義' Dim i As Integer '配列に値を格納' '1⇒ピンク 2⇒青 3⇒空白 Stars(1) = 1 Stars(2) = 1 Stars(3) = 1 Stars(4) = 0 Stars(5) = 2 Stars(6) = 2 Stars(7) = 2 '画面表示' Call Cards_Repaint End Sub Sub Cards_Repaint() '画面表示' For i = LBound(Stars) To UBound(Stars) If Stars(i) = 0 Then '空白' Sheets("IMG").Range("M1:Q6").Copy Sheets("MAIN").Cells(3, 2 + 6 * (i - 1)) ElseIf Stars(i) = 1 Then 'ピンク' Sheets("IMG").Range("A1:E6").Copy Sheets("MAIN").Cells(3, 2 + 6 * (i - 1)) ElseIf Stars(i) = 2 Then '青' Sheets("IMG").Range("G1:K6").Copy Sheets("MAIN").Cells(3, 2 + 6 * (i - 1)) End If Next i Range("G10:G11") = "" ‘選択されたカードの番号をクリア(後述)’ End Sub
<解説>
配列Starsには各カードの種類を表す番号を格納していきます。
このゲーム内ではピンクが3枚、空白1枚、青が3枚という構成なのでStarsの要素数は7とします。
次に、『Gards_Repaint』プロシージャを作成してカードを描画します。
このコードの中では『IMG』シートからセルをコピーして『MAIN』シートへカードを並べていきます。
<実行結果>
それでは『MAIN』シートに『START』ボタンを作成し、上記コードを登録して実行してみましょう。
配列の要素数の順番で、左からカードが並んでいます。
クリック操作に対応
次に、セルをクリックすることにより各カードの場所を入れ替えるコードを入力していきます。
『MAIN』シートをダブルクリックしてシートのイベントを記述するためのモジュールを開き、
左上部のタブから『Worksheet』、右上部のタブから『SelectionChange』を選択して『SelectionChange』プロシージャを作成します。
このプロシージャは『MAIN』シート内で選択されているセルの位置が変更された場合を検知します。
つまり、『SelectionChange』でクリックイベントに対する処理を組み込むことができるのです。
<コード②>
Private Sub Worksheet_SelectionChange(ByVal Target As Range) '変数定義' Dim pos_Star As Integer 'カードの場所を示す数値を格納 Dim i As Integer Dim int_Change As Integer 'カードをクリックした場合は場所を記録する If Target.Row >= 3 And Target.Row <= 8 And _ Target.Column <= 42 Then pos_Star = Int((Target.Column + 4) / 6) If Range("G10").Value = "" Then '1枚目を選択した場合' Range("G10").Value = pos_Star Else '2枚目を選択した場合 Range("G11").Value = pos_Star End If If Target.Column Mod 6 = 1 Then GoTo end_Select_Star '処理を中断 End If Else 'カード以外の場所をクリックした場合 GoTo end_Select_Star '処理を中断 End If ‘<コード④(後述)を記述> Exit Sub ‘画面を初期化して終了’ end_Select_Star: Range("G10:G11").Value = "" End Sub
<解説>
まずは変数pos_Starを定義し、左から何番目のカードが選択されたかを記録します。
選択されているセルの行数は『Target.Row』、列数は『Target.Column』という変数に格納されています。
というわけで、カードが配置されている範囲内のセルが選択されたら処理を行うようにします。
このゲームでは2枚のカードを選択して交換するので、1枚目のカード位置は『G10』セルに、2枚目のカード位置は『G11』セルに記録しています。
そしてカードが配置されていない場所のセルをクリックした場合は『end_Select_Star』ラベルへ移動し、『G10』『G11』セルをクリアして処理を終了しています。
<実行結果>
カードの枠線の色を変える
ところで、このままではどのカードが選択された状態か分かりづらいのでカードの枠線に色を付けます。
新しく『Paint_Line』というプロシージャを作成し、コード②の最後から呼び出すこととします。
<コード③>
Sub Paint_Line(ByVal myPos As Integer, ByVal myColor As Long) '選択されたカードの枠線に色を付ける' With Range(Cells(4, myPos * 6 - 4), Cells(8, myPos * 6)) .Borders(xlEdgeBottom).Color = myColor ‘色の設定’ .Borders(xlEdgeBottom).Weight = xlThick ‘枠線の太さの設定’ .Borders(xlEdgeTop).Color = myColor .Borders(xlEdgeTop).Weight = xlThick .Borders(xlEdgeRight).Color = myColor .Borders(xlEdgeRight).Weight = xlThick .Borders(xlEdgeLeft).Color = myColor .Borders(xlEdgeLeft).Weight = xlThick End With End Sub
<解説>
引数『myPos』で左から何枚目のカードが選択されているかを判断し、『myColor』で枠線の色を指定します。
ちなみに色の情報についてはコード④(後述)で説明しますがLong値で取得します。
そして対象となるセルの上下左右について『xlEdgeBottom』『xlEdgeTop』『xlEdgeRight』『xlEdgeLeft』という引数で
線の太さと色の設定を行っています。
<コード④(コード②の最後に記述)>
'枠線を色付きで囲む If pos_Star > 0 Then 'カードが選択された場合 Call Paint_Line(pos_Star, RGB(0, 255, 0)) End If
<解説>
カードが選択されている場合は『Paint_Line』へカードの座標と色の値を渡します。
色を表現するRGB関数に引数として赤・緑・青の割合を表す3つの数字を渡すと、戻り値としてLong値が返ります。
<実行結果>
この状態ではまだ変更した枠線の色は黒に戻りませんが、後に修正するのでこのままにしておきます。
カードの場所を交換
<コード⑤(コード④の続きに記述>
'カードを2枚選択したら互いの場所を交換 If Range("G10") <> "" And Range("G11") <> "" Then If Range("G10") = Range("G11") Then '同じカードを選んだ場合' GoTo end_Select_Star '処理を中断 ElseIf Stars(Range("G10")) > 0 And Stars(Range("G11")) > 0 Then '両方星マークのカードを選んだ場合' '枠線の色を黒に戻す For i = LBound(Stars) To UBound(Stars) Call Paint_Line(i, RGB(0, 0, 0)) Next i GoTo end_Select_Star '処理を中断 Else '以下ABの条件を満たす場合にカードの位置を交換できる' 'A:一方が星、一方が空白のカードを選択している場合 ⇒ 前処理で判定済み' 'B:2枚のカードの距離が2枚以内の場合' If Abs(Range("G10") - Range("G11")) <= 2 Then '配列に値を格納 For i = LBound(Stars) To UBound(Stars) Stars(i) = Cells(3, 6 * i - 2) Next i '配列の要素を交換 int_Change = Stars(Range("G10")) Stars(Range("G10")) = Stars(Range("G11")) Stars(Range("G11")) = int_Change '画面再表示 Call Cards_Repaint '枠線の色を黒に戻す For i = LBound(Stars) To UBound(Stars) Call Paint_Line(i, RGB(0, 0, 0)) Next i End If End If End If
<解説>
まずはカードが2枚選択されていることをセルG10・G11で確認します。
次に同じカードが選ばれている場合や両方のカードが星マークである場合・
カードの距離が2枚以上離れている場合もカードの交換はできないので処理を中断します。
これらの条件に当てはまらない場合は各カードの番号を配列『Stars』に格納して場所を交換します。
そして『Cards_Repaint』でカードを再描画し、枠線の色を黒に戻します。
<SelectionChangeのエラーを修正>
ところで、ここまでのコードを書いた状態でMAINシートをクリックすると枠線が点滅したような状態になり、
入力処理を受け付けなくなってしまいます。
これはSelectionChange内のコードにいずれかのセルを選択する処理がある場合、
再度SelectionChangeのイベントが発動し、コードが無限にループしてしまうことによる現象です。
こうなってしまうとExcelがフリーズして強制終了するか、『Ctrl』+『Pause』キーを押して
VBAの処理を強制的に中断するしかありません。
このようにイベントが連鎖的に発生することを防ぐために、『EnableEvents』のステータスを
Falseにする処理を追記します。
また、カードのクリック処理を再度受け付けたい場面では『EnableEvents』のステータスはTrueへ修正しましょう。
<コード⑥:MAINプロシージャに赤字部分を追記>
Sub MAIN() '変数定義' Dim i As Integer '配列に値を格納' '1⇒ピンク 2⇒青 3⇒空白 Stars(1) = 1 Stars(2) = 1 Stars(3) = 1 Stars(4) = 0 Stars(5) = 2 Stars(6) = 2 Stars(7) = 2 'イベントの連鎖を中断' Application.EnableEvents = False '画面表示' Call Cards_Repaint '再度クリックイベントを受け付ける' Application.EnableEvents = True End Sub
<コード⑦:SelectionChangeプロシージャの最初と最後に赤字部分を追記>
Private Sub Worksheet_SelectionChange(ByVal Target As Range) '変数定義' Dim pos_Star As Integer 'カードの場所を示す数値を格納 Dim i As Integer Dim int_Change As Integer 'イベントの連鎖を中断' Application.EnableEvents = False ・ ・ ・ ‘コード⑧を記述(後述) '再度クリックイベントを受け付ける' Application.EnableEvents = True Exit Sub '画面を初期化して終了' end_Select_Star: Range("G10:G11").Value = "" '再度クリックイベントを受け付ける' Application.EnableEvents = True End Sub
<解説>
イベントの連鎖を止めたい場合にEnableEventsのステータスをFalseに、
クリックイベントを再度受け付けたい場合にTrueへ修正しています。
なお、SelectionChangeではend_Select_Starを経由して終了した場合と経由せずに終了した場合の
2パターンについて修正が必要な点に注意してください。
<実行結果>
カードの位置をクリックで入れ替えられるようになりました。
採点
いよいよ、カードの並び替え結果を採点してみましょう。
<コード⑧:コード⑦の途中に記述>
'採点' '配列に値を格納' For i = LBound(Stars) To UBound(Stars) Stars(i) = Cells(3, 6 * i - 2) Next i If Stars(1) = 2 And Stars(2) = 2 And Stars(3) = 2 _ And Stars(4) = 0 And Stars(5) = 1 A MsgBox "OK!" 'クリア' End If
<解説>
配列『Stars』に各カードの番号を格納し、左から3枚目までが青い星、4枚目が空白、
5枚目から右端までがピンクの星の場合にクリアメッセージを表示します。
<実行結果>
補足
ここまででコードは完成ですが、カード上部に表示されている番号はゲーム上不要なので
『IMG』シートで文字色を白に変更し、見えないようにしておきましょう。
まとめ
入れ替えゲームではカードの柄をIMGシートに用意し、カードの位置を配列で管理します。
そしてカードの入れ替えはSelectionChangeのイベントを使用しますが、
SelectionChangeはイベントの連鎖が発生しやすいのでEnableEventsのステータスを適宜調整します。
そしてカードの枚数や模様を変えればまた違った雰囲気で楽しめそうですね。