Excel将棋:マクロVBAの学習用(№1)
Excelで将棋を作ってみましょう。
しかし、Excelでそのようなソフトを作ろうと言うのではありません。
と言いますか、残念ながら私には作れません、、、
とりあえずは、人vs人で動かしてゲームとして成立するところまでを目標とします。
VBAテクニックの紹介として、意図的に多彩な方法を使っていきます。
したがって、同じようなことを違う方法で実装する場合も出てくるかもしれません。
Excel将棋を作る目的はVBAの学習であり、これをお伝えするための記事として進めていきます。
したがって最終的にどのようなものになるかは、作りながら考えていきます。
マクロVBAの基本事項は他のページで学習してください。
ExcelマクロVBA入門
初回の今回は、要件定義とシート作成までになります。
次回以降、クラスの設計から入り1つずつ実装していく予定です。
Excel将棋の要件定義
・選択している駒の移動可能場所の強調表示
・再度同じ駒をクリックで解除
・移動先のクリックで駒を移動
・敵陣に入った場合
・敵陣内で動いた場合
・敵陣から外に出た場合
・動けないところに駒を進める
・二手指し
・二歩
・王手放置
・身動きの取れない駒
・打ち歩詰め
・連続王手の千日手
※より下の方がより難しいと思われますが、実装順は適宜検討
持ち時間の実装は予定せず。可能なら実装
Excel将棋のシート作成
完成シート
![VBA マクロ Excel将棋](image133.jpg)
シートを作成するマクロVBA
駒の配置は「対局開始」のマクロで行うのでここでは必要ありませんが、書式の確認のために入れています。
Sub シート作成()
Dim ws As Worksheet
Set ws = ActiveWorkbook.ActiveSheet
ws.Cells.Clear
ActiveWindow.DisplayGridlines = False
Dim rng As Range
Set rng = ws.Range("B2")
ws.Names.Add Name:="開始位置", RefersToLocal:=rng
Call 名前定義設定(rng)
Call 列幅行高設定(rng)
Call セル結合設定(rng)
Call セル書式設定(rng)
Call 文字設定(rng)
End Sub
Sub 名前定義設定(ByVal rng As Range)
With rng.Worksheet
.Names.Add Name:="将棋盤", RefersToLocal:=rng.Offset(4, 5).Resize(9, 9)
.Names.Add Name:="先手持駒", RefersToLocal:=rng.Offset(6, 16).Resize(7, 2)
.Names.Add Name:="先手消費時間", RefersToLocal:=rng.Offset(15, 12).Resize(1, 2)
.Names.Add Name:="後手持駒", RefersToLocal:=rng.Offset(4, 1).Resize(7, 2)
.Names.Add Name:="後手消費時間", RefersToLocal:=rng.Offset(1, 6).Resize(1, 2)
.Names.Add Name:="手数", RefersToLocal:=rng.Offset(15, 5)
.Names.Add Name:="棋譜", RefersToLocal:=rng.Offset(15, 6).Resize(1, 3)
End With
End Sub
Sub 列幅行高設定(ByVal rng As Range)
With rng.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 rng.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
End Sub
Sub セル結合設定(ByVal rng As Range)
With rng.Worksheet
.Range("後手消費時間").Merge
.Range("先手消費時間").Merge
.Range("棋譜").Merge
End With
End Sub
Sub セル書式設定(ByVal rng As Range)
With rng.Worksheet.Range("開始位置")
.Resize(17, 19).BorderAround LineStyle:=xlContinuous
End With
With rng.Worksheet.Range("将棋盤")
.Offset(-1, -1).Resize(11, 11).BorderAround LineStyle:=xlContinuous, Weight:=xlThick
.Offset(-1, -1).Resize(11, 11).Interior.Color = RGB(255, 222, 117)
.Borders.LineStyle = xlContinuous
.Font.Name = "AR教科書体M"
.Font.Size = 20
.Font.Bold = True
.HorizontalAlignment = xlCenter
.Resize(3).Font.Name = "@AR教科書体M" '後手陣のみ
.Resize(3).Orientation = 90 '後手陣のみ
.Offset(-1).Resize(1).Font.Name = "MS Pゴシック"
.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 = "MS Pゴシック"
.Offset(, 9).Resize(, 1).Font.Size = 8
.Offset(, 9).Resize(, 1).HorizontalAlignment = xlCenter
.Offset(, 9).Resize(, 1).VerticalAlignment = xlCenter
End With
With rng.Worksheet.Range("先手持駒")
.BorderAround LineStyle:=xlContinuous
.Interior.Color = RGB(255, 222, 117)
.Offset(, 0).Resize(, 1).Font.Name = "AR教科書体M"
.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 = "MS Pゴシック"
.Offset(, 1).Resize(, 1).Font.Size = 11
.Offset(, 1).Resize(, 1).Font.Bold = True
.Offset(, 1).Resize(, 1).HorizontalAlignment = xlLeft
End With
With rng.Worksheet.Range("後手持駒")
.BorderAround LineStyle:=xlContinuous
.Interior.Color = RGB(255, 222, 117)
.Offset(, 1).Resize(, 1).Font.Name = "@AR教科書体M"
.Offset(, 1).Resize(, 1).Orientation = 90
.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 = "MS Pゴシック"
.Offset(, 0).Resize(, 1).Font.Size = 11
.Offset(, 0).Resize(, 1).Font.Bold = True
.Offset(, 0).Resize(, 1).HorizontalAlignment = xlRight
End With
With rng.Worksheet.Range("先手消費時間")
.Offset(, -1).Resize(, 3).BorderAround LineStyle:=xlContinuous
.Offset(, -1).Resize(, 3).Interior.Color = vbBlack
.Offset(, -1).Resize(, 3).Font.Name = "MS Pゴシック"
.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 rng.Worksheet.Range("後手消費時間")
.Offset(, -1).Resize(, 3).BorderAround LineStyle:=xlContinuous
.Offset(, -1).Resize(, 3).Interior.Color = vbWhite
.Offset(, -1).Resize(, 3).Font.Name = "MS Pゴシック"
.Offset(, -1).Resize(, 3).Font.Size = 11
.Offset(, -1).Resize(, 3).Font.Bold = True
.HorizontalAlignment = xlCenter
.NumberFormatLocal = "h:mm:ss"
End With
With rng.Worksheet.Range("手数")
.Resize(, 4).Borders.LineStyle = xlContinuous
.Resize(, 4).Interior.Color = RGB(252, 228, 217)
.Resize(, 4).Font.Name = "MS Pゴシック"
.Resize(, 4).Font.Size = 11
End With
End Sub
Sub 文字設定(ByVal rng As Range)
Dim ary1(1 To 9, 1 To 9)
Dim i As Long, j As Long
For i = 1 To 9
For j = 1 To 9
Select Case i
Case 1, 9
Select Case j
Case 1, 9
ary1(i, j) = "香"
Case 2, 8
ary1(i, j) = "桂"
Case 3, 7
ary1(i, j) = "銀"
Case 4, 6
ary1(i, j) = "金"
Case 5
ary1(i, j) = "王"
End Select
Case 2, 8
If (i = 2 And j = 2) Or (i = 8 And j = 8) Then
ary1(i, j) = "飛"
End If
If (i = 2 And j = 8) Or (i = 8 And j = 2) Then
ary1(i, j) = "角"
End If
Case 3, 7
ary1(i, j) = "歩"
End Select
Next
Next
With rng.Worksheet
.Range("将棋盤").Offset(-1).Resize(1).Value = Array(9, 8, 7, 6, 5, 4, 3, 2, 1)
.Range("将棋盤").Offset(, 9).Resize(, 1).Value = WorksheetFunction.Transpose(Array("一", "二", "三", "四", "五", "六", "七", "八", "九"))
.Range("先手消費時間").Offset(, -1).Resize(, 1).Value = "先手"
.Range("先手消費時間").Value = TimeSerial(1, 15, 15)
.Range("後手消費時間").Offset(, -1).Resize(, 1).Value = "後手"
.Range("後手消費時間").Value = TimeSerial(1, 15, 15)
.Range("将棋盤").Value = ary1
.Range("先手持駒").Offset(, 0).Resize(, 1).Value = WorksheetFunction.Transpose(Array("飛", "角", "金", "銀", "桂", "香", "歩"))
.Range("先手持駒").Offset(, 1).Resize(, 1).Value = WorksheetFunction.Transpose(Array(2, 2, 4, 4, 4, 4, 18))
.Range("後手持駒").Offset(, 1).Resize(, 1).Value = WorksheetFunction.Transpose(Array("歩", "香", "桂", "銀", "金", "角", "飛"))
.Range("後手持駒").Resize(, 1).Value = WorksheetFunction.Transpose(Array(18, 4, 4, 4, 4, 2, 2))
.Range("手数").Value = 100
.Range("棋譜").Value = "▲3三銀右上成"
End With
End Sub
※フォントや色は適宜変更してください。
書式設定は特に他で使いまわすことも無いので、VBAをダラダラと一つずつ記述しています。
場所ごとに細かく設定しているので、細部が少しずつ違っています。
名前定義については以下を参照してください。
文字を逆さまにする方法
・フォント名の先頭に@を付ける
・文字の方向を90度上にする
ただし、半角文字は逆さまにできません。
![VBA マクロ Excel将棋](image316.jpg)
![VBA マクロ Excel将棋](image3153.jpg)
Excel将棋の目次
同じテーマ「マクロVBAサンプル集」の記事
数独(ナンプレ)を解くアルゴリズムの要点とパフォーマンスの検証№1
ナンバーリンク(パズル)を解くVBAに挑戦№1
ナンバーリンクを解くVBAのパフォーマンス改善№1
オセロを作りながらマクロVBAを学ぼう
他ブックへのリンクエラーを探し解除
Excelシートの複雑な計算式を解析するVBA
Excel将棋:マクロVBAの学習用(№1)
Excel囲碁:万波奈穂先生に捧ぐ
Excel囲碁:再起動後も続けて打てるように改造
エクセルVBAで15パズルを作ってみた
エクセル麻雀ミニゲーム
新着記事NEW ・・・新着記事一覧を見る
正規表現関数(REGEXTEST,REGEXREPLACE,REGEXEXTRACT)|エクセル入門(2024-07-02)
エクセルが起動しない、Excelが立ち上がらない|エクセル雑感(2024-04-11)
ブール型(Boolean)のis変数・フラグについて|VBA技術解説(2024-04-05)
テキストの内容によって図形を削除する|VBA技術解説(2024-04-02)
ExcelマクロVBA入門目次|エクセルの神髄(2024-03-20)
VBA10大躓きポイント(初心者が躓きやすいポイント)|VBA技術解説(2024-03-05)
テンキーのスクリーンキーボード作成|ユーザーフォーム入門(2024-02-26)
無効な前方参照か、コンパイルされていない種類への参照です。|エクセル雑感(2024-02-17)
初級脱出10問パック|VBA練習問題(2024-01-24)
累計を求める数式あれこれ|エクセル関数応用(2024-01-22)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得(End,Rows.Count)|VBA入門
2.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.RangeとCellsの使い方|VBA入門
6.ブックを閉じる・保存(Close,Save,SaveAs)|VBA入門
7.メッセージボックス(MsgBox関数)|VBA入門
8.セルのクリア(Clear,ClearContents)|VBA入門
9.並べ替え(Sort)|VBA入門
10.ブック・シートの選択(Select,Activate)|VBA入門
- ホーム
- マクロVBA応用編
- マクロVBAサンプル集
- Excel将棋:マクロVBAの学習用(№1)
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。