Excel将棋：駒を動かす(№9)

公開日：2013年5月以前　最終更新日：2020-08-31

Excel将棋：駒を動かす(№9)

Excelで将棋を作ってみましょう。
人vs人で動かしてゲームとして成立するところまでが当面の目標です。

今回は、駒を動かします。
駒を動かせるように将棋進行クラスを拡張します。
将棋進行クラスの完成はまだまだこれからですが、駒を動かせるようになるとゲームらしくなってきます。
作成するクラス全体の設計は、№2. Excel将棋：クラスの設計、こちらを参照してください。

・作成するクラスの役割と作成順・作成するクラスのメンバー一覧・駒の移動の定義・Excel将棋の目次

※クラス名、プロシージャー名、変数名に日本語を使用しています。

駒クラスにプロパティ追加

将棋進行クラスに駒を動かす機能を追加する過程で、
駒クラスに以下のプロパティが必要になりました。


  
    
      Public Property Get 駒(ByVal arg位置 As g位置) As cls駒

      　　Set 駒 = pAry駒(arg位置.行, arg位置.列)

End Property

配列の位置を指定して、駒オブジェクトを戻すプロパティです。
以下の将棋進行クラスで使用しています。

将棋進行クラスの変更点

追加した機能は、
・駒を動かす
・手数、棋譜の表示
・先手後手ごとに消費時間を表示

今後の機能拡張を見据えて、全体的に変更しました。
主な変更点
・名前定義（先手消費時間→先手時間、後手も同様）
・メソッド「駒選択」→「駒選択着手」
・メソッド「着手」の実装
・メソッド「盤面表示」のバグ修正と機能追加

ここまでのVBAコードを組み込んだExcelファイルは以下からダウンロード出来ます。

エクセルのサンプルダウンロード

将棋進行クラスのVBA


  
    
      Option Explicit


'盤面配色定数：自由に設定可

Private Const cnsFont As String = "AR教科書体M"

Private Const cns将棋盤色 As Long = &H75DEFF 'RGB(255, 222, 117)

Private Const cns駒選択色 As Long = &HD9E4FC 'RGB(252, 228, 217)


'API

Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)


'イベント用

Private WithEvents xlApp As Excel.Application

Private p前回選択 As Range

Private p今回選択 As Range


'Excel将棋の書くオブジェクト

Private obj将棋盤 As cls将棋盤

Private obj先手駒台 As cls駒台

Private obj後手駒台 As cls駒台


'シートおよび名前定義の設定

Private pWs As Worksheet

Private p開始位置 As Range

Private p将棋盤 As Range

Private p先手持駒 As Range

Private p後手持駒 As Range

Private p先手時間 As Range

Private p後手時間 As Range

Private p手数 As Range

Private p棋譜 As Range

Private p将棋盤色 As Range

Private p駒選択色 As Range


'先手後手の定数

Private Const c先手 As Boolean = True

Private Const c後手 As Boolean = False


'その他変数

Private dt最終時刻 As Date

Private dt先手時間 As Date

Private dt後手時間 As Date


'**********************************************************************

' 公開メソッド：ゲーム開始だけ、他はイベントで処理

'**********************************************************************


Public Sub ゲーム開始()

　　'シート選択

　　Dim flgNew As Boolean

　　On Error Resume Next

　　Set p開始位置 = ActiveSheet.Range("開始駒位置")

　　If Err Then

　　　　Err.Clear

　　　　Set p開始位置 = Application.InputBox( _

　　　　　　　　　　　　prompt:="将棋盤を作成するシートの作成開始左上をクリックしてください。" & vbLf & _

　　　　　　　　　　　　"※シートは全消去されます。", _

　　　　　　　　　　　　Title:="作成シート選択", _

　　　　　　　　　　　　Type:=8)

　　　　If Err Then Exit Sub

　　　　flgNew = True

　　Else

　　　　flgNew = False

　　End If

　　On Error GoTo 0

　　Set pWs = p開始位置.Worksheet

　　Application.Goto p開始位置

　　

　　Application.Cursor = xlWait

　　Application.ScreenUpdating = False

　　Set xlApp = Nothing

　　

　　If flgNew Then

　　　　'新規シート

　　　　pWs.Cells.Clear

　　　　ActiveWindow.DisplayGridlines = False

　　　　pWs.Names.Add Name:="開始駒位置", RefersToLocal:=p開始位置

　　　　Call シート名前定義

　　　　Call シート書式設定

　　Else

　　　　'既存シート

　　　　Call シート名前定義

　　　　Call シート消去

　　End If

　　

　　Set xlApp = p開始位置.Application

　　Application.ScreenUpdating = True

　　Call 駒配置 '大橋流でゆっくり並べる

　　Application.Cursor = xlDefault

　　

　　dt最終時刻 = Now(): dt先手時間 = 0: dt後手時間 = 0

End Sub


'**********************************************************************

' イベント

'**********************************************************************


Private Sub Class_Initialize()

　　Set obj将棋盤 = New cls将棋盤

　　Set obj先手駒台 = New cls駒台

　　Set obj後手駒台 = New cls駒台

End Sub


Private Sub Class_Terminate()

　　Set xlApp = Nothing

　　Set obj将棋盤 = Nothing

　　Set obj先手駒台 = Nothing

　　Set obj後手駒台 = Nothing

End Sub


'WithEventsのxlAppのイベント

Private Sub xlApp_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

　　If p将棋盤 Is Nothing Then Exit Sub

　　If Not Sh Is p将棋盤.Worksheet Then Exit Sub

　　If Intersect(p将棋盤, Target.Item(1)) Is Nothing Then Exit Sub

　　If Err Then Exit Sub

　　

　　Call 選択セルを手番に移動

　　

　　Set p前回選択 = p今回選択

　　Set p今回選択 = Target.Item(1)

　　

　　Call 駒選択着手

End Sub


'**********************************************************************

' 非公開メソッド

'**********************************************************************


'大橋流でゆっくり駒を並べます。

Private Sub 駒配置()

　　Dim ary駒配置

　　ary駒配置 = Array( _

　　　　　　　　Array(5, 9, "玉", c先手), Array(5, 1, "玉", c後手), _

　　　　　　　　Array(6, 9, "金", c先手), Array(4, 1, "金", c後手), _

　　　　　　　　Array(4, 9, "金", c先手), Array(6, 1, "金", c後手), _

　　　　　　　　Array(7, 9, "銀", c先手), Array(3, 1, "銀", c後手), _

　　　　　　　　Array(3, 9, "銀", c先手), Array(7, 1, "銀", c後手), _

　　　　　　　　Array(8, 9, "桂", c先手), Array(2, 1, "桂", c後手), _

　　　　　　　　Array(2, 9, "桂", c先手), Array(8, 1, "桂", c後手), _

　　　　　　　　Array(9, 9, "香", c先手), Array(1, 1, "香", c後手), _

　　　　　　　　Array(1, 9, "香", c先手), Array(9, 1, "香", c後手), _

　　　　　　　　Array(8, 8, "角", c先手), Array(2, 2, "角", c後手), _

　　　　　　　　Array(2, 8, "飛", c先手), Array(8, 2, "飛", c後手), _

　　　　　　　　Array(5, 7, "歩", c先手), Array(5, 3, "歩", c後手), _

　　　　　　　　Array(6, 7, "歩", c先手), Array(4, 3, "歩", c後手), _

　　　　　　　　Array(4, 7, "歩", c先手), Array(6, 3, "歩", c後手), _

　　　　　　　　Array(7, 7, "歩", c先手), Array(3, 3, "歩", c後手), _

　　　　　　　　Array(3, 7, "歩", c先手), Array(7, 3, "歩", c後手), _

　　　　　　　　Array(8, 7, "歩", c先手), Array(2, 3, "歩", c後手), _

　　　　　　　　Array(2, 7, "歩", c先手), Array(8, 3, "歩", c後手), _

　　　　　　　　Array(9, 7, "歩", c先手), Array(1, 3, "歩", c後手), _

　　　　　　　　Array(1, 7, "歩", c先手), Array(9, 3, "歩", c後手))

　　DoEvents

　　Sleep 300

　　

　　Dim i As Long, j As Long

　　With obj将棋盤

　　　　For i = LBound(ary駒配置) To UBound(ary駒配置)

　　　　　　.着手 ary駒配置(i)(2), Nothing, 棋譜位置(ary駒配置(i)(0), ary駒配置(i)(1)), ary駒配置(i)(3)

　　　　　　Call 盤面表示(obj将棋盤.現在盤面, obj先手駒台.駒台一覧, obj後手駒台.駒台一覧)

　　　　　　Sleep 100

　　　　Next

　　End With

End Sub


'棋譜の筋・段を配列の行・列に変換

Private Function 棋譜位置(ByVal arg列 As Integer, ByVal arg行 As Integer) As g位置

　　Set 棋譜位置 = g位置(arg行, 10 - arg列)

End Function


'盤内を選択した時に駒選択と移動可能位置の色設定を行う

'移動可能位置をクリックした場合は駒を移動する

Private Sub 駒選択着手()

　　'いったん盤全体を既定色に

　　p将棋盤.Interior.Color = p将棋盤色.Interior.Color

　　

　　If p今回選択 Is Nothing Then Exit Sub

　　

　　'同じ駒を選択したときは解除

　　If Not p前回選択 Is Nothing Then

　　　　If p前回選択.Address = p今回選択.Address Then

　　　　　　Call 選択解除

　　　　　　Exit Sub

　　　　End If

　　End If

　　

　　'手番の駒以外（相手の駒）は選択できない

　　If p今回選択.Value <> "" Then

　　　　If obj将棋盤.駒(セル2位置(p今回選択)).先手 <> obj将棋盤.先手 Then

　　　　　　Call 選択解除

　　　　　　Exit Sub

　　　　End If

　　End If

　　

　　'駒を移動

　　If Not p前回選択 Is Nothing Then

　　　　If 着手(p前回選択, p今回選択) Then

　　　　　　Call 選択解除

　　　　　　Exit Sub

　　　　End If

　　End If

　　

　　'駒のない場所の選択は無視

　　If p今回選択.Value = "" Then

　　　　Call 選択解除

　　　　Exit Sub

　　End If

　　

　　'選択駒と移動可能位置の色変更

　　p今回選択.Interior.Color = p駒選択色.Interior.Color

　　Call 駒移動可能位置色変更(obj将棋盤.駒移動可能位置(セル2位置(p今回選択)))

End Sub


'駒選択後に移動可能位置を選択したら着手します

Private Function 着手(ByVal arg元位置 As Range, ByVal arg先位置 As Range) As Boolean

　　着手 = False

　　

　　Dim tmp先位置 As g位置

　　Set tmp先位置 = セル2位置(arg先位置)

　　

　　Dim Col As Collection

　　Set Col = obj将棋盤.駒移動可能位置(セル2位置(arg元位置))

　　

　　'移動可能位置かの判定

　　Dim tmp可能位置 As g位置

　　Dim flg移動 As Boolean: flg移動 = False

　　For Each tmp可能位置 In Col

　　　　If tmp可能位置.行 = tmp先位置.行 And _

　　　　　 tmp可能位置.列 = tmp先位置.列 Then

　　　　　　flg移動 = True

　　　　　　Exit For

　　　　End If

　　Next

　　If Not flg移動 Then

　　　　Exit Function

　　End If

　　

　　'画面表示にかかる時間を含めないようにここで処理

　　If obj将棋盤.先手 Then

　　　　dt先手時間 = dt先手時間 + Now() - dt最終時刻

　　Else

　　　　dt後手時間 = dt後手時間 + Now() - dt最終時刻

　　End If

　　

　　'着手してシートを更新

　　Call obj将棋盤.着手(arg元位置.Value, セル2位置(arg元位置), tmp先位置, obj将棋盤.先手)

　　Call 盤面表示(obj将棋盤.現在盤面, _

　　　　　　　　　obj先手駒台.駒台一覧, obj後手駒台.駒台一覧, _

　　　　　　　　　obj将棋盤.棋譜, obj将棋盤.棋譜履歴.Count)

　　

　　Call 選択セルを手番に移動

　　着手 = True

End Function


'前回選択と今回選択を消去して選択状態を解除

Private Sub 選択解除()

　　Set p前回選択 = Nothing

　　Set p今回選択 = Nothing

End Sub


      '次のSheetSelectionChangeが効くように先手後手の位置へ選択セルを移動させる

Private Sub 選択セルを手番に移動()

　　xlApp.EnableEvents = False

　　xlApp.Goto IIf(obj将棋盤.先手, p先手時間.Offset(, -1), p後手時間.Offset(, -1))

　　xlApp.EnableEvents = True

End Sub


'セル選択位置を配列の位置に変換

Private Function セル2位置(ByVal argRng As Range) As g位置

　　Dim r As Long, c As Long

　　r = argRng.Row - p将棋盤.Row + 1

　　c = argRng.Column - p将棋盤.Column + 1

　　Set セル2位置 = g位置(r, c)

End Function


'駒を選択した時に駒の移動可能位置の色設定を行う

Private Sub 駒移動可能位置色変更(ByVal argCol As Collection)

　　If argCol Is Nothing Then Exit Sub

　　Dim tmp位置 As g位置

　　For Each tmp位置 In argCol

　　　　p将棋盤.Resize(1, 1).Offset(tmp位置.行 - 1, tmp位置.列 - 1).Interior.Color = p駒選択色.Interior.Color

　　Next

End Sub


'盤面配列をシートに表示する

Private Sub 盤面表示(ByRef arg盤面() As String, _

　　　　　　　　　　 ByRef arg先手駒台() As Variant, _

　　　　　　　　　　 ByRef arg後手駒台() As Variant, _

　　　　　　　　　　 Optional ByVal arg棋譜 As String, _

　　　　　　　　　　 Optional ByVal arg手数 As Long)

　　Application.ScreenUpdating = False

　　

　　'将棋盤

　　Dim i As Long, j As Long

　　For i = 1 To 9

　　　　For j = 1 To 9

　　　　　　With p将棋盤(i, j)

　　　　　　　　If Right(arg盤面(i, j), 1) = "↑" Then

　　　　　　　　　　If .Font.Name <> cnsFont Then

　　　　　　　　　　　　.Font.Name = cnsFont

　　　　　　　　　　End If

　　　　　　　　　　If .Orientation <> xlHorizontal Then

　　　　　　　　　　　　.Orientation = xlHorizontal

　　　　　　　　　　End If

　　　　　　　　ElseIf Right(arg盤面(i, j), 1) = "↓" Then

　　　　　　　　　　If .Font.Name <> "@" & cnsFont Then

　　　　　　　　　　　　.Font.Name = "@" & cnsFont

　　　　　　　　　　End If

　　　　　　　　　　If .Orientation <> xlUpward Then

　　　　　　　　　　　　.Orientation = xlUpward

　　　　　　　　　　End If

　　　　　　　　End If

　　　　　　　　If .Value <> Trim(Left(arg盤面(i, j), 1)) Then

　　　　　　　　　　.Value = Trim(Left(arg盤面(i, j), 1))

　　　　　　　　End If

　　　　　　End With

　　　　Next

　　Next

　　

　　'先手持駒 ※駒を取る機能と合わせて実装※

　　

　　'後手持駒 ※駒を取る機能と合わせて実装※

　　

　　'棋譜・手数表示

　　If arg棋譜 <> "" Then

　　　　p棋譜.Value = arg棋譜

　　　　p手数.Value = arg手数

　　　　p先手時間.Value = dt先手時間

　　　　p後手時間.Value = dt後手時間

　　　　dt最終時刻 = Now()

　　End If

　　

　　Application.ScreenUpdating = True

　　DoEvents

End Sub


'玉の詰み判定し、詰んでいれば終局

Private Function 終局判定() As Boolean

　　'※※※これは難しいので後回し※※※

　　'cls将棋盤の終局判定を使用する

End Function


'**********************************************************************

' シート設定：名前定義と書式設定

'**********************************************************************


Private Sub シート消去()

　　p将棋盤.ClearContents

　　p先手持駒.ClearContents

　　p後手持駒.ClearContents

　　p先手時間.ClearContents

　　p後手時間.ClearContents

　　p手数.ClearContents

　　p棋譜.ClearContents

　　p将棋盤.Interior.Color = cns将棋盤色

End Sub


Private Sub シート名前定義()

　　With pWs

　　　　.Names.Add Name:="将棋盤", RefersToLocal:=p開始位置.Offset(4, 5).Resize(9, 9)

　　　　.Names.Add Name:="先手持駒", RefersToLocal:=p開始位置.Offset(6, 16).Resize(7, 2)

　　　　.Names.Add Name:="先手時間", RefersToLocal:=p開始位置.Offset(15, 12).Resize(1, 2)

　　　　.Names.Add Name:="後手持駒", RefersToLocal:=p開始位置.Offset(4, 1).Resize(7, 2)

　　　　.Names.Add Name:="後手時間", RefersToLocal:=p開始位置.Offset(1, 6).Resize(1, 2)

　　　　.Names.Add Name:="手数", RefersToLocal:=p開始位置.Offset(15, 5)

　　　　.Names.Add Name:="棋譜", RefersToLocal:=p開始位置.Offset(15, 6).Resize(1, 3)

　　　　.Names.Add Name:="将棋盤色", RefersToLocal:=p開始位置.Offset(0, 18)

　　　　.Names.Add Name:="駒選択色", RefersToLocal:=p開始位置.Offset(1, 18)

　　　　Set p将棋盤 = .Range("将棋盤")

　　　　Set p先手持駒 = .Range("先手持駒")

　　　　Set p先手時間 = .Range("先手時間")

　　　　Set p後手持駒 = .Range("後手持駒")

　　　　Set p後手時間 = .Range("後手時間")

　　　　Set p手数 = .Range("手数")

　　　　Set p棋譜 = .Range("棋譜")

　　　　Set p将棋盤色 = .Range("将棋盤色")

　　　　Set p駒選択色 = .Range("駒選択色")

　　End With

End Sub


Private Sub シート書式設定()

　　'列幅行高設定()

　　With p開始位置.EntireColumn

　　　　.Offset(, 0).ColumnWidth = 2.4

　　　　.Offset(, 1).ColumnWidth = 2.4

　　　　.Offset(, 2).ColumnWidth = 4

　　　　.Offset(, 3).ColumnWidth = 0.47

　　　　.Offset(, 4).ColumnWidth = 1.6

　　　　.Offset(, 5).Resize(, 9).ColumnWidth = 4

　　　　.Offset(, 14).ColumnWidth = 1.6

　　　　.Offset(, 15).ColumnWidth = 0.47

　　　　.Offset(, 16).ColumnWidth = 4

　　　　.Offset(, 17).ColumnWidth = 2.4

　　　　.Offset(, 18).ColumnWidth = 2.4

　　End With

　　With p開始位置.EntireRow

　　　　.Offset(0).Resize(17).RowHeight = 18

　　　　.Offset(2).RowHeight = 4.8

　　　　.Offset(3).RowHeight = 13.8

　　　　.Offset(4).Resize(9).RowHeight = 28.2

　　　　.Offset(13).RowHeight = 13.8

　　　　.Offset(14).RowHeight = 4.8

　　End With


　　'セル結合設定()

　　With pWs

　　　　.Range("後手時間").Merge

　　　　.Range("先手時間").Merge

　　　　.Range("棋譜").Merge

　　End With


　　'セル書式設定()

　　With p将棋盤色

　　　　.Interior.Color = cns将棋盤色

　　　　.BorderAround LineStyle:=xlContinuous

　　End With

　　With p駒選択色

　　　　.Interior.Color = cns駒選択色

　　　　.BorderAround LineStyle:=xlContinuous

　　End With

　　With p開始位置

　　　　.Resize(17, 19).BorderAround LineStyle:=xlContinuous

　　End With

　　With p将棋盤

　　　　.Offset(-1, -1).Resize(11, 11).BorderAround LineStyle:=xlContinuous, Weight:=xlThick

　　　　.Offset(-1, -1).Resize(11, 11).Interior.Color = p将棋盤色.Interior.Color

　　　　.Borders.LineStyle = xlContinuous

　　　　.Font.Name = cnsFont

　　　　.Font.Size = 20

　　　　.Font.Bold = True

　　　　.HorizontalAlignment = xlCenter

　　　　.Resize(3).Font.Name = "@" & cnsFont '後手陣のみ

　　　　.Resize(3).Orientation = xlUpward '後手陣のみ

　　　　.Offset(-1).Resize(1).Font.Name = "ＭＳ Ｐゴシック"

　　　　.Offset(-1).Resize(1).Font.Size = 8

　　　　.Offset(-1).Resize(1).HorizontalAlignment = xlCenter

　　　　.Offset(-1).Resize(1).VerticalAlignment = xlCenter

　　　　.Offset(, 9).Resize(, 1).Font.Name = "ＭＳ Ｐゴシック"

　　　　.Offset(, 9).Resize(, 1).Font.Size = 8

　　　　.Offset(, 9).Resize(, 1).HorizontalAlignment = xlCenter

　　　　.Offset(, 9).Resize(, 1).VerticalAlignment = xlCenter

　　End With

　　With p先手持駒

　　　　.BorderAround LineStyle:=xlContinuous

　　　　.Interior.Color = p将棋盤色.Interior.Color

　　　　.Offset(, 0).Resize(, 1).Font.Name = cnsFont

　　　　.Offset(, 0).Resize(, 1).Font.Size = 20

　　　　.Offset(, 0).Resize(, 1).Font.Bold = True

　　　　.Offset(, 0).Resize(, 1).HorizontalAlignment = xlCenter

　　　　.Offset(, 1).Resize(, 1).Font.Name = "ＭＳ Ｐゴシック"

　　　　.Offset(, 1).Resize(, 1).Font.Size = 11

　　　　.Offset(, 1).Resize(, 1).Font.Bold = True

　　　　.Offset(, 1).Resize(, 1).HorizontalAlignment = xlLeft

　　End With

　　With p後手持駒

　　　　.BorderAround LineStyle:=xlContinuous

　　　　.Interior.Color = p将棋盤色.Interior.Color

　　　　.Offset(, 1).Resize(, 1).Font.Name = "@" & cnsFont

　　　　.Offset(, 1).Resize(, 1).Orientation = xlUpward

　　　　.Offset(, 1).Resize(, 1).Font.Size = 20

　　　　.Offset(, 1).Resize(, 1).Font.Bold = True

　　　　.Offset(, 1).Resize(, 1).HorizontalAlignment = xlCenter

　　　　.Offset(, 0).Resize(, 1).Font.Name = "ＭＳ Ｐゴシック"

　　　　.Offset(, 0).Resize(, 1).Font.Size = 11

　　　　.Offset(, 0).Resize(, 1).Font.Bold = True

　　　　.Offset(, 0).Resize(, 1).HorizontalAlignment = xlRight

　　End With

　　With p先手時間

　　　　.Offset(, -1).Resize(, 3).BorderAround LineStyle:=xlContinuous

　　　　.Offset(, -1).Resize(, 3).Interior.Color = vbBlack

　　　　.Offset(, -1).Resize(, 3).Font.Name = "ＭＳ Ｐゴシック"

　　　　.Offset(, -1).Resize(, 3).Font.Size = 11

　　　　.Offset(, -1).Resize(, 3).Font.Bold = True

　　　　.Offset(, -1).Resize(, 3).Font.Color = vbWhite

　　　　.HorizontalAlignment = xlCenter

　　　　.NumberFormatLocal = "h:mm:ss"

　　End With

　　With p後手時間

　　　　.Offset(, -1).Resize(, 3).BorderAround LineStyle:=xlContinuous

　　　　.Offset(, -1).Resize(, 3).Interior.Color = vbWhite

　　　　.Offset(, -1).Resize(, 3).Font.Name = "ＭＳ Ｐゴシック"

　　　　.Offset(, -1).Resize(, 3).Font.Size = 11

　　　　.Offset(, -1).Resize(, 3).Font.Bold = True

　　　　.HorizontalAlignment = xlCenter

　　　　.NumberFormatLocal = "h:mm:ss"

　　End With

　　With p手数

　　　　.Resize(, 4).Borders.LineStyle = xlContinuous

　　　　.Resize(, 4).Interior.Color = p駒選択色.Interior.Color

　　　　.Resize(, 4).Font.Name = "ＭＳ Ｐゴシック"

　　　　.Resize(, 4).Font.Size = 11

　　　　.Resize(, 4).Font.Bold = True

　　End With


　　'文字設定()

　　p将棋盤.Offset(-1).Resize(1).Value = Array(9, 8, 7, 6, 5, 4, 3, 2, 1)

　　p将棋盤.Offset(, 9).Resize(, 1).Value = WorksheetFunction.Transpose(Array("一", "二", "三", "四", "五", "六", "七", "八", "九"))

　　p先手時間.Offset(, -1).Resize(, 1).Value = "先手"

　　p後手時間.Offset(, -1).Resize(, 1).Value = "後手"

　　p将棋盤色.Offset(, -2).Value = "将棋盤色"

　　p駒選択色.Offset(, -2).Value = "駒選択色"

      End Sub

駒選択着手

セル選択時の挙動
・同じ駒を選択したときは解除
・移動可能範囲外を選択したら駒を移動
・手番の駒以外（相手の駒）は選択できない
・駒のない場所の選択は無視
・選択した駒と移動可能位置の色変更

ここでの判定については、もっと良い方法がありそうですが、今後作成を進めていく過程で良い方法が出てくれば変更します。

着手

・移動可能位置かの判定
・着手してシートを更新
・次のSheetSelectionChangeが効くように先手後手の位置へ選択セルを移動させる

Excel将棋の実行動作

Excel将棋の目次

№1. Excel将棋：マクロVBAの学習用

・Excel将棋の要件定義・Excel将棋のシート作成・Excel将棋の目次

№2. Excel将棋：クラスの設計

・作成するクラスの役割と作成順・作成するクラスのメンバー一覧・駒の移動の定義・Excel将棋の目次

№3. Excel将棋：駒クラスの作成

・位置クラス・移動クラス・駒クラス・駒クラスVBAの解説・使用しているVBAの参考ページ・Excel将棋の目次

№4. Excel将棋：駒クラスの単体テスト

・駒クラスのテスト内容・駒クラスのテストVBAコード・駒クラスのテストVBAの結果・Excel将棋の目次

№5. Excel将棋：駒台クラスの作成&単体テスト

・駒クラス・駒台クラスVBAの解説・駒台クラスのテストVBAコード・駒クラスのテストVBAの結果・Excel将棋の目次

№6. Excel将棋：位置クラスをデフォルトインスタンスに変更

・デフォルトインスタンスに変更する理由と方法・位置クラスのインポート用ソース・cls位置とg位置の使い方の違い・位置クラス変更に伴う駒クラスの変更・Excel将棋の目次

№7. Excel将棋：将棋盤クラスの作成&単体テスト

・将棋盤クラス・将棋盤クラスVBAの解説・将棋盤クラスのテストVBAコード・将棋盤クラスのテストVBAの結果・Excel将棋の目次

№8. Excel将棋：将棋進行クラスの作成

・将棋進行クラス・将棋進行クラスVBAの解説・将棋進行クラスの起動方法・将棋盤クラスのテストVBAの結果・Excel将棋の目次

№9. Excel将棋：駒を動かす

・駒クラスにプロパティ追加・将棋進行クラスの変更点・将棋進行クラスのVBA ・Excel将棋の実行動作・Excel将棋の目次

№10. Excel将棋：相手の駒を取る、持ち駒を打つ

・主な変更追加箇所・全体の構成・Excel将棋の動作・Excel将棋の全VBAコード・Excel将棋の目次

№11. Excel将棋：駒を成る

・主な変更追加箇所・Excel将棋の動作・変更したクラスのVBA ・Excel将棋の目次

№12. Excel将棋：棋譜をユーザーフォームに表示する

・棋譜について・主な変更内容・ユーザーフォームの作成・Excel将棋の動作・変更したクラスのVBA ・Excel将棋の目次

№13. Excel将棋：棋譜選択でその時点の盤面に戻す

・Excel将棋の動作・全体構成図・全プロシージャー・プロパティの一覧・クリックで着手した時の主なプロシージャーの流れ・Excel将棋のダウンロード・Excel将棋の目次

№14. Excel将棋：棋譜ファイルの出力と読込自動再生

・Excel将棋の動作・VBAの修正箇所について・Excel将棋のダウンロード・棋譜KIFファイルのサンプル・Excel将棋の目次

№15. Excel将棋：反則（禁じ手）判定

・反則（禁じ手）・Excel将棋の動作・各クラスの共通で持つプロパティを整理・VBAの修正箇所について・Excel将棋のダウンロード・Excel将棋の目次

№16. Excel将棋：終局（詰み）判定と打ち歩詰め

・反則（禁じ手）・Excel将棋の動作・VBAの追加・修正箇所について・Excel将棋のダウンロード・Excel将棋の目次

№17. Excel将棋：千日手と連続王手の千日手

・反則（禁じ手）・Excel将棋の動作・VBAの修正箇所について・Excel将棋のダウンロード・Excel将棋の目次

№18 Excel将棋：ひとまず完成、これまでとこれから

・Excel将棋のこれから・Excel将棋の目次・Excel将棋のダウンロード・当初のクラス設計・作成するクラスのメンバー一覧・全体構成図・全プロシージャー・プロパティの一覧・全VBAコード

№19 Excel将棋：棋譜ファイルから対局一覧作成

・対局一覧のシート・Excel将棋の動作・全体構成図・Excel将棋のダウンロード・新規追加したVBAコード・Excel将棋の目次

アクセスランキング・・・ランキング一覧を見る

1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.繰り返し処理（For Next)｜VBA入門
4.変数宣言のDimとデータ型｜VBA入門
5.RangeとCellsの使い方｜VBA入門
6.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
7.メッセージボックス(MsgBox関数)｜VBA入門
8.セルのクリア（Clear,ClearContents）｜VBA入門
9.ブック・シートの選択（Select,Activate）｜VBA入門
10.条件分岐（Select Case）｜VBA入門

ホーム
マクロVBA応用編
マクロVBAサンプル集
Excel将棋：駒を動かす(№9)

このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。

記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。

VBAサンプル集
Excel将棋：駒を動かす(№9)