新感覚手抜きExcelオセロの遊び方

Excelを使ったオセロで遊ぼうのコーナーです

ここでは具体的な使い方をご説明していきます

ステップ①

新規のExcelワークシートを用意

ステップ②

名前を付けて保存で"マクロ有効ブック(.xlsm)"として保存しよう

ステップ③

Excelのファイルからオプションを選択

ステップ④

リボンのユーザー設定から「開発」にチェックを入れます

ステップ⑤

キーボードで「Alt」+「F11」キーでVBAエディタを起動

挿入タブより、標準モジュールをプロジェクトに追加します

ステップ⑥

標準モジュールが追加された状態

ステップ⑦

Sheet1(Sheet1)

Module1

それぞれにコードを打ち込んでいきます

※打ち込むコードは最後にまとめて記述します

ステップ⑧

コードを打ち込んだら一旦上書き保存しちゃいましょう

その後、開発タブから挿入を選択し、ボタンを挿入します

たぶん一番左上にあるやつです

ステップ⑨

作ったボタンにマクロを登録しましょう

登録するマクロ名は"GameStart"

コードが正しく打てていれば、自動的に出てきます

後はボタンを押すことでゲームスタート！

※ボタンは「Ctrl」+「左クリック」で移動させることができます

・白先行の黒後行でゲームが開始されます

・ダブルクリックで石を置けます

・ななめを判定する機能は搭載していません

・盤面上であれば反転の有無に関わらず石を置くことができます

とりあえず試作で作ってみましたが、ななめ判定がないと面白みがあまりないですね

やっぱり既存のルールって完成されてる！！

使っているパソコンのOSやExcelバージョン次第ですが、上記説明と異なる部分がある可能性があります

コードの使用は自己責任でお願いいたします

もしかしたらとんでもないバグが入ってるかもしれません(; ･`д･´)

以下コードです

Sheet1用

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim click_row As Integer
Dim click_column As Integer
click_row = Target.Row
click_column = Target.Column

Cancel = True
If click_row >= 2 And click_row <= 9 And click_column >= 2 And click_column <= 9 Then

If Cells(Target.Row, Target.Column).Value = "" Then

Dim Stn As String
Dim RevStn As String

If StnCnt Mod 2 = 1 Then
Stn = "○"
RevStn = "●"
Else
Stn = "●"
RevStn = "○"
End If

Cells(Target.Row, Target.Column).Value = Stn

If LeftRevCheck(click_row, click_column, Stn, RevStn) = True Then
Debug.Print "左に裏返す石あり"
Else
Debug.Print "左に裏返す石なし"
End If

If RightRevCheck(click_row, click_column, Stn, RevStn) = True Then
Debug.Print "右に裏返す石あり"
Else
Debug.Print "右に裏返す石なし"
End If

If UpRevCheck(click_row, click_column, Stn, RevStn) = True Then
Debug.Print "上に裏返す石あり"
Else
Debug.Print "上に裏返す石なし"
End If

If DownRevCheck(click_row, click_column, Stn, RevStn) = True Then
Debug.Print "下に裏返す石あり"
Else
Debug.Print "下に裏返す石なし"
End If

StnCnt = StnCnt + 1

Else
MsgBox "既に石が置かれています"
End If

Else
MsgBox "そこには石を置けません"
End If

End Sub

Module1用

Const LTOP_ROW As Integer = 2
Const LTOP_COLUMN As Integer = 2
Public StnCnt As Long

Sub GameStart()

Range("B2:I9").Clear
StnCnt = 1


Range("B:I").ColumnWidth = 4
Range("2:9").RowHeight = 25.8


With Range("B2:I9")
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Font.Size = 20
End With

Dim Center_Row As Long
Dim Center_Column As Long

Center_Row = LTOP_ROW + 3
Center_Column = LTOP_COLUMN + 3


Cells(5, 5).Value = "○"
Cells(6, 6).Value = "○"
Cells(5, 6).Value = "●"
Cells(6, 5).Value = "●"

Cells(2, 11).Value = "自分・・・○"
Cells(3, 11).Value = "相手・・・●"

End Sub

Public Function LeftRevCheck(click_row, click_column, Stn, RevStn)

Dim check_result As Boolean
check_result = False

Dim DoCnt As Long
DoCnt = 1

If click_column - 2 >= LTOP_COLUMN Then
If Cells(click_row, click_column - 1).Value = RevStn Then
i = click_column - 2

Do While i >= LTOP_COLUMN
If Cells(click_row, i).Value = Stn Then
check_result = True

For j = 1 To DoCnt
Cells(click_row, click_column - j).Value = Stn
Next j

Exit Do
End If

If Cells(click_row, i).Value = "" Then
Exit Do
End If

i = i - 1
DoCnt = DoCnt + 1
Loop

End If
End If

LeftRevCheck = check_result

End Function

Public Function RightRevCheck(click_row, click_column, Stn, RevStn)

Dim check_result As Boolean
check_result = False

Dim DoCnt As Long
DoCnt = 1

If click_column + 2 <= LTOP_COLUMN + 8 Then
If Cells(click_row, click_column + 1).Value = RevStn Then
i = click_column + 2

Do While i <= LTOP_COLUMN + 8
If Cells(click_row, i).Value = Stn Then
check_result = True

For j = 1 To DoCnt
Cells(click_row, click_column + j).Value = Stn
Next j

Exit Do
End If

If Cells(click_row, i).Value = "" Then
Exit Do
End If

i = i + 1
DoCnt = DoCnt + 1
Loop
End If
End If

RightRevCheck = check_result

End Function

Public Function UpRevCheck(click_row, click_column, Stn, RevStn)

Dim check_result As Boolean
check_result = False

Dim DoCnt As Long
DoCnt = 1

If click_row - 2 >= LTOP_ROW Then
If Cells(click_row - 1, click_column).Value = RevStn Then
i = click_row - 2

Do While i >= LTOP_ROW
If Cells(i, click_column).Value = Stn Then
check_result = True

For j = 1 To DoCnt
Cells(click_row - j, click_column).Value = Stn
Next j

Exit Do
End If

If Cells(i, click_column).Value = "" Then
Exit Do
End If

i = i - 1
DoCnt = DoCnt + 1
Loop
End If
End If

UpRevCheck = check_result

End Function

Public Function DownRevCheck(click_row, click_column, Stn, RevStn)

Dim check_result As Boolean
check_result = False

Dim DoCnt As Long
DoCnt = 1

If click_row + 2 <= LTOP_ROW + 8 Then
If Cells(click_row + 1, click_column).Value = RevStn Then
i = click_row + 2

Do While i <= LTOP_ROW + 8
If Cells(i, click_column).Value = Stn Then
check_result = True

For j = 1 To DoCnt
Cells(click_row + j, click_column).Value = Stn
Next j

Exit Do
End If

If Cells(i, click_column).Value = "" Then
Exit Do
End If

i = i + 1
DoCnt = DoCnt + 1
Loop
End If
End If

DownRevCheck = check_result

End Function