LoginSignup
0
0

More than 3 years have passed since last update.

オセロをVBAで作成 #2石を置く処理

Last updated at Posted at 2019-10-17

オセロをVBAで作成 #2石を置く処理

とりあえず石を置く処理まで完成したので投稿してみます。
参考サイト:https://tech.pjin.jp/blog/2016/07/15/excel-othello-1/

Const LEFT_TOP_ROW As Integer = 3   '盤面左上角の行の座標
Const LEFT_TOP_COLUMN As Integer = 3    '盤面左上角の列の座標
Const RIGHT_BOTTOM_ROW As Integer = 10 '盤面右下角の行の座標
Const RIGHT_BOTTOM_COLUMN As Integer = 10 '盤面右下角の列の座標
Const BLACK_STONE As String = "●"      '黒石定数
Const WHITE_STONE As String = "○"      '白石定数

Public stone_count As Integer   '石のカウント変数
Dim cell_click_row As Integer   'ダブルクリックしたセル行
Dim cell_click_column As Integer    'ダブルクリックしたセル列

参考サイトで定数と変数を使用して座標と石の文字列を管理していたので同じように定数宣言してみました。
定数や変数を使用することで数値や文字列が何を示しているのかわかりやすくなったと思います。
Constは定数の宣言、Publicはどのプロシージャでも使えるの意、Dimはプロシージャ外で宣言していると
そのモジュール内でしか使えません。プロシージャ内宣言だとプロシージャ内限定で使用できます。

Sub GameStartButtun() 'ゲームスタートボタンを押す

    MsgBox "ゲームスタート"

    '手数の初期化
    stone_count = 1

    'セル方眼紙準備
    Dim px As Integer 'Integer型変数px宣言

    px = 80 'セル方眼紙の基準になる正方形の一辺の長さ[px]

    ' セルの高さと幅を設定
    Cells.ColumnWidth = px * 0.118
    Cells.RowHeight = px * 0.75

    'オセロの盤面のセルデータクリア
    Range(Cells(LEFT_TOP_ROW, LEFT_TOP_COLUMN), Cells(RIGHT_BOTTOM_ROW, RIGHT_BOTTOM_COLUMN)) = ""

    'オセロの盤面と初期配置の4つの石を表示
    Range(Cells(LEFT_TOP_ROW, LEFT_TOP_COLUMN), Cells(RIGHT_BOTTOM_ROW, RIGHT_BOTTOM_COLUMN)).Borders.LineStyle = xlContinuous '盤面の罫線
    Range(Cells(LEFT_TOP_ROW, LEFT_TOP_COLUMN), Cells(RIGHT_BOTTOM_ROW, RIGHT_BOTTOM_COLUMN)).Interior.ColorIndex = 4 '盤面の色塗り
    Range(Cells(LEFT_TOP_ROW, LEFT_TOP_COLUMN), Cells(RIGHT_BOTTOM_ROW, RIGHT_BOTTOM_COLUMN)).Font.Size = 36 'フォントサイズ指定
    Range(Cells(LEFT_TOP_ROW, LEFT_TOP_COLUMN), Cells(RIGHT_BOTTOM_ROW, RIGHT_BOTTOM_COLUMN)).HorizontalAlignment = xlCenter '水平方向中央揃え
    Range(Cells(LEFT_TOP_ROW, LEFT_TOP_COLUMN), Cells(RIGHT_BOTTOM_ROW, RIGHT_BOTTOM_COLUMN)).VerticalAlignment = xlCenter '垂直方向中央揃え

    '初期配置のオセロを配置
    Cells(LEFT_TOP_ROW + 3, LEFT_TOP_COLUMN + 3) = WHITE_STONE
    Cells(LEFT_TOP_ROW + 4, LEFT_TOP_COLUMN + 4) = WHITE_STONE
    Cells(LEFT_TOP_ROW + 3, LEFT_TOP_COLUMN + 4) = BLACK_STONE
    Cells(LEFT_TOP_ROW + 4, LEFT_TOP_COLUMN + 3) = BLACK_STONE

変数・定数を使用したことでゲームスタートボタンの処理内容を少し変えてます。
stone_countの初期化と盤面のセルデータクリアの処理を追加してます。
変数名が長くてちょっと読みにくくなっちゃったかもしれません。。。

Sub cell_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    cell_click_row = Target.Row '選択した行を代入
    cell_click_column = Target.COLUMN '選択した列を代入

    '盤上か判定
    If cell_click_row >= 3 And 10 >= cell_click_row And cell_click_column >= 3 And 10 >= cell_click_column Then

        'セル内編集モードのキャンセル
        Cancel = True

        '石が既にあるかの判定
        If Cells(cell_click_row, cell_click_column).Value = "" Then

            '石を入れる変数
            Dim stone As String

            'フォントサイズ指定
            Cells(2, 1).Font.Size = 36
            '●か○か選択
            If stone_count Mod 2 = 1 Then    'ターン数が偶数回か奇数回かのIf文
                '置き終わったら「白の番です」と表示
                Cells(2, 1) = "「白の番です」"
                '奇数の場合
                stone = BLACK_STONE     '置く石は黒
                reverse_stone = WHITE_STONE     'ひっくり返す石は白
            Else
                '置き終わったら「黒の番です」と表示
                Cells(2, 1) = "「黒の番です」"
                '偶数の場合
                stone = WHITE_STONE     '置く石は白
                reverse_stone = BLACK_STONE     'ひっくり返す石は黒
            End If

            '石を置く
            Cells(Target.Row, Target.COLUMN).Value = stone

            If left_change_check(cell_click_row, cell_click_column, stone, reverse_stone) = True Then  'ひっくり返せるかのチェック結果をメッセージで出力
                MsgBox "左側に裏返す石があります。"
            Else
                MsgBox "左側に裏返す石がありません。"
            End If

            '手数をカウントアップ
            stone_count = stone_count + 1
        Else
            MsgBox "既に石が置かれています。"
        End If
    Else
        MsgBox "盤上ではありません。"
    End If
End Sub

'ひっくり返す石があるかチェック関数(左方向)
Function left_change_check(cell_row, cell_column, stone, reverse_stone)
    Dim check_result As Boolean 'チェック結果を入れる変数
    check_result = False    'ひっくり返らないFalseで初期化
    If cell_column - 2 >= LEFT_TOP_COLUMN Then  '左端から3列目より右側かどうか
        If Cells(cell_row, cell_column - 1) = reverse_stone Then '左隣の石が置いた石と反対の色の石か
            i = cell_column - 2 'さらにもう一個隣の石の列の座標
            Do While i >= LEFT_TOP_COLUMN   '盤面左端をはみ出ない範囲でループ
                If Cells(cell_row, i).Value = stone Then    '同色の石が出てきた場合
                    check_result = True     'ひっくり返せる判定True
                    Exit Do     'ループ抜ける
                End If

                If Cells(cell_row, i).Value = "" Then '空白セルだった場合
                    check_result = False    'ひっくり返せる判定False
                End If
                i = i - 1   '一つ左にずれる
            Loop
        End If
    End If
    left_change_check = check_result 'check_resultの値を返す
End Function

cell_BeforeDoubleClickプロシージャを使って盤上のセルをダブルクリックした際に石を置いたら次の色の石の番へ変わるようにしています。そして同時にreverse_stone変数に反対の色の石を代入してます。
そして対象の色の石を選択したセルにCells(Target.Row, Target.COLUMN).Value = stoneの部分で
置いてます。
そして石が既に置かれていれば”既に石が置かれています”とメッセージが出るようにしてます。
盤外だと”盤上ではありません”とメッセージが表示されます。
Function left_change_checkで左方向にひっくり返す判定を行いそのチェック結果をメッセージボックスで
"左側に裏返す石があります。"か"左側に裏返す石がありません。"で表示するようになってます。

2019-10-17 (2).png

まとめ

判定文が複雑になってきてソースを張ってコメントを添えるだけになってしまってますね。。。
少しずつでも見やすい投稿の仕方を覚えていきたいと思います。
実は投稿する前の段階ではひっくり返す判定を返す文の位置がおかしくてうまく機能してませんでした。
複雑になればなるほどこういう事態が多くなりそうなので細部まで正しく記述出来てるか見る力も養いたいと思います。

0
0
0

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
0
0