Option Explicit
Sub othello() 'メイン関数
Dim x As Integer, bpass As Integer, wpass As Integer
Dim n As Integer, m As Integer, bcount As Integer, wcount As Integer, okiba As Integer
Module3.Macro3
start
Module3.Macro
Module6.Macro
Do
puttingblack bpass
Module9.okiba okiba
If bpass + wpass >= 2 Then
MsgBox ("二人ともパスだったので対局を終了します")
Exit Do
ElseIf okiba = 0 Then
MsgBox ("置き場が無くなったので対局を終了します")
Exit Do
End If
wpass = 0
puttingwhite wpass
Module9.okiba okiba
If bpass + wpass >= 2 Then
MsgBox ("二人ともパスだったので対局を終了します")
Exit Do
ElseIf okiba = 0 Then
MsgBox ("置き場が無くなったので対局を終了します")
Exit Do
End If
bpass = 0
Loop Until x
For n = 2 To 9
For m = 2 To 9
If Sheet1.Cells(n, m).Interior.Color = RGB(0, 0, 0) Then
bcount = bcount + 1
ElseIf Sheet1.Cells(n, m).Interior.Color = RGB(255, 255, 255) Then
wcount = wcount + 1
End If
Next m
Next n
If bcount > wcount Then
MsgBox ("黒") & bcount & ("対白") & wcount & ("で黒の勝ちです")
ElseIf bcount < wcount Then
MsgBox ("黒") & bcount & ("対白") & wcount & ("で白の勝ちです")
ElseIf bcount = wcount Then
MsgBox ("黒") & bcount & ("対白") & wcount & ("で引き分けです")
End If
End Sub
Sub start()
Dim n As Integer, m As Integer
With Sheet1
Module3.Macro4
For m = 2 To 9
For n = 2 To 9
.Cells(n, m).Interior.Color = RGB(0, 255, 0)
Next n
Next m
.Cells(4 + 1, 4 + 1).Interior.Color = RGB(255, 255, 255)
.Cells(5 + 1, 5 + 1).Interior.Color = RGB(255, 255, 255)
.Cells(4 + 1, 5 + 1).Interior.Color = RGB(0, 0, 0)
.Cells(5 + 1, 4 + 1).Interior.Color = RGB(0, 0, 0)
End With
End Sub
Sub puttingblack(bpass As Integer)
Dim x As Integer, y As Integer, c As Integer, xx As String, yy As String
Dim handan As Integer
handan = 0
Module9.kuroban
Do
bstart:
c = 1
xx = InputBox("上から何行目？0を2回入力するとパスになります", "黒の番です", 0)
If xx = "" Then
MsgBox ("番号が不正です。もう一度入力してください")
GoTo bstart
End If
yy = InputBox("左から何列目？0を2回入力するとパスになります", "黒の番です", 0)
If xx = "" Or yy = "" Then
MsgBox ("番号が不正です。もう一度入力してください")
GoTo bstart
End If
x = Val(xx)
y = Val(yy)
If x = 0 And y = 0 Then
MsgBox ("パスしました")
bpass = bpass + 1
Exit Do
ElseIf x = 0 Or y = 0 Or x < 1 Or x > 8 Or y < 1 Or y > 8 Then
MsgBox ("番号が不正です。もう一度入力してください")
GoTo bstart
End If
y = y + 1
x = x + 1
search_for_black x, y, handan
With Sheet1
If .Cells(x, y).Interior.Color = RGB(0, 255, 0) And handan <> 0 Then
.Cells(x, y).Interior.Color = RGB(0, 0, 0)
Else: MsgBox x - 1 & (",") & y - 1 & ("は置けません!")
c = 0
End If
End With
Loop While c = 0
End Sub
Sub puttingwhite(wpass As Integer)
Dim x As Integer, y As Integer, c As Integer, xx As String, yy As String
Dim handan As Integer
handan = 0
Module9.siroban
Do
wstart:
c = 1
xx = InputBox("上から何行目？0を2回入力するとパスになります", "白の番です", 0)
If xx = "" Then
MsgBox ("番号が不正です。もう一度入力してください")
GoTo wstart
End If
yy = InputBox("左から何列目？0を2回入力するとパスになります", "白の番です", 0)
If xx = "" Or yy = "" Then
MsgBox ("番号が不正です。もう一度入力してください")
GoTo wstart
End If
x = Val(xx)
y = Val(yy)
If x = 0 And y = 0 Then
MsgBox ("パスしました")
wpass = wpass + 1
Exit Do
ElseIf x = 0 Or y = 0 Then
MsgBox ("番号が不正です。もう一度入力してください")
GoTo wstart
End If
y = y + 1
x = x + 1
search_for_white x, y, handan
With Sheet1
If .Cells(x, y).Interior.Color = RGB(0, 255, 0) And handan <> 0 Then
.Cells(x, y).Interior.Color = RGB(255, 255, 255)
Else: MsgBox x - 1 & (",") & y - 1 & ("は置けません!")
c = 0
End If
End With
Loop While c = 0
End Sub
