VBAサンプル集
Excel将棋:マクロVBAの学習用(№1)

ExcelマクロVBAの実用サンプル、エクセルVBA集と解説
最終更新日:2020-08-31

Excel将棋:マクロVBAの学習用(№1)


Excelで将棋を作ってみましょう。


今やコンピューター将棋はプロをしのぐ強さです。
しかし、Excelでそのようなソフトを作ろうと言うのではありません。
と言いますか、残念ながら私には作れません、、、

ExcelマクロVBAの学習素材として将棋を作ってみましょう。
とりあえずは、人vs人で動かしてゲームとして成立するところまでを目標とします。

VBAはクラスの作成が中心になっていくと思います。
VBAテクニックの紹介として、意図的に多彩な方法を使っていきます。
したがって、同じようなことを違う方法で実装する場合も出てくるかもしれません。
Excel将棋を作る目的はVBAの学習であり、これをお伝えするための記事として進めていきます。

少しずつVBAを作成しつつ記事を書いていくことになります。
したがって最終的にどのようなものになるかは、作りながら考えていきます。

本シリーズでは、VBAコードの解説は要点だけになります。
マクロVBAの基本事項は他のページで学習してください。
本シリーズの中では、適宜下記の該当する解説ページへのリンクを付けておくようにします。
ExcelマクロVBA入門
・VBA学習の進め方について ・1. VBAの基礎・基本:VBA入門 ・2. VBA入門に必要なVBEの基本的使い方 ・3. VBAプログラミングの基礎・基本 ・4. Excel各種機能とオブジェクトの理解:VBA入門 ・5. VBA初級からVBA中級を目指して ・6. VBA入門の後日追加記事 ・7. VBA入門その後の学習について
Excelマクロ再入門
・準備:VBA再入門 ・セルを扱う:VBA再入門 ・エクセルの便利機能:VBA再入門 ・ブック・シートを扱う:VBA再入門 ・マクロ全体を最適化する:VBA再入門 ・自動化への道:VBA再入門 ・最後に:VBA再入門 ・VBAエキスパートを受験する人は
VBAクラス入門
VBAの学習を続けていくと、いずれ必ずクラスとかオブジェクト指向といった言葉に出くわします。VBAクラスについて、基礎から実践応用まで解説していきます。VBEの「挿入」の一番下にある「クラスモジュール」については、存在は知っていても使う機会が無かったかもしれません。

初回の今回は、要件定義とシート作成までになります。
次回以降、クラスの設計から入り1つずつ実装していく予定です。


Excel将棋の要件定義

・駒の初期配置
「対局開始」で駒を初期配置する。
・1クリックで駒の選択、次のクリックで駒を移動
・手番側の駒をクリックで選択している駒を強調表示
・選択している駒の移動可能場所の強調表示
・再度同じ駒をクリックで解除
・移動先のクリックで駒を移動
・駒の移動先に相手の駒があれば取る
取った駒は駒台に移動
・敵陣(3段位内)に入ったら成るか成らないか選択
駒が成れる条件
・敵陣に入った場合
・敵陣内で動いた場合
・敵陣から外に出た場合
・反則(禁じ手)は着手不可とする
以下の反則(禁じ手)は着手自体が出来ないようにする。
・動けないところに駒を進める
・二手指し
・二歩
・王手放置
・身動きの取れない駒
・打ち歩詰め
・連続王手の千日手
※より下の方がより難しいと思われますが、実装順は適宜検討
・詰み判定で勝敗を表示
玉が詰んでいる、または「投了」ボタンで終局し、勝敗を表示
・先手後手それぞれの消費時間の表示
秒単位の切り捨てとして累計時間を表示
持ち時間の実装は予定せず。可能なら実装

Excel将棋のシート作成

完成シート

VBA マクロ Excel将棋

※マクロを起動するボタンは、今後の記事で随時追加していきます。

シートを作成するマクロVBA

手作業でも良いのですが、いつでもどのシートでも作成できるように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をダラダラと一つずつ記述しています。
場所ごとに細かく設定しているので、細部が少しずつ違っています。

複数のシートでゲームができるように、名前定義はシート範囲としています。
名前定義については以下を参照してください。
第92回.名前定義(Names)|VBA入門
・Namesコレクション ・Nameオブジェクト ・RangeオブジェクトのNameプロパティ ・名前定義を使ったRangeの書き方 ・シートコピー時は名前定義に注意 ・名前定義の実践例

OffsetResizeを多用しています。
第82回.RangeのResizeプロパティ|VBA入門
・Resizeプロパティの構文 ・Resizeの使用例 ・Resizeのまとめ
第83回.RangeのOffsetプロパティ|VBA入門
・Offsetプロパティの構文 ・Offsetの使用例 ・Offsetの注意点 ・Offsetのまとめ
Offset、Resizeを使いこなそう|VBA技術解説
・OffsetプロパティとResizeプロパティの構文 ・OffsetとResizeの基本 ・Offsetの注意点 ・OffsetとResizeの応用 ・OffsetやResizeでVBAが簡潔になる例

文字を逆さまにする方法

文字を逆さまにするには以下の設定をします。
・フォント名の先頭に@を付ける
・文字の方向を90度上にする
ただし、半角文字は逆さまにできません。

VBA マクロ Excel将棋

VBA マクロ 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将棋の目次



同じテーマ「マクロVBAサンプル集」の記事

数独(ナンプレ)を解くアルゴリズムの要点とパフォーマンスの検証№1
ナンバーリンク(パズル)を解くVBAに挑戦№1
ナンバーリンクを解くVBAのパフォーマンス改善№1
オセロを作りながらマクロVBAを学ぼう
他ブックへのリンクエラーを探し解除
Excelシートの複雑な計算式を解析するVBA
Excel将棋:マクロVBAの学習用(№1)
Excel囲碁:万波奈穂先生に捧ぐ
Excel囲碁:再起動後も続けて打てるように改造
エクセルVBAで15パズルを作ってみた
エクセル麻雀ミニゲーム


新着記事NEW ・・・新着記事一覧を見る

数字(1~50)を丸付き数字に変換するVBA|VBA技術解説(2022-11-15)
TEXTAFTER関数(テキストの指定文字列より後ろの部分を返す)|エクセル入門(2022-11-14)
TEXTBEFORE関数(テキストの指定文字列より前の部分を返す)|エクセル入門(2022-11-14)
TEXTSPLIT関数(列と行の区切り記号で文字列を分割)|エクセル入門(2022-11-12)
LAMBDA以降の新関数はVBAで使えるか|VBA技術解説(2022-11-11)
WRAPCOLS関数(1次元配列を指定数の列で折り返す)|エクセル入門(2022-11-08)
WRAPROWS関数(1次元配列を指定数の行で折り返す)|エクセル入門(2022-11-08)
EXPAND関数(配列を指定された行と列に拡張する)|エクセル入門(2022-11-07)
TAKE関数(配列の先頭/末尾から指定行/列数を取得)|エクセル入門(2022-11-06)
DROP関数(配列の先頭/末尾から指定行/列数を除外)|エクセル入門(2022-11-06)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.繰り返し処理(For Next)|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.Excelショートカットキー一覧|Excelリファレンス
7.並べ替え(Sort)|VBA入門
8.エクセルVBAでのシート指定方法|VBA技術解説
9.マクロって何?VBAって何?|VBA入門
10.ExcelマクロVBAの基礎を学習する方法|エクセルの神髄




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


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



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