Excel将棋：位置クラスをデフォルトインスタンスに変更(№6)
Excelで将棋を作ってみましょう。
人vs人で動かしてゲームとして成立するところまでが当面の目標です。
作成するクラス全体の設計は、№2. Excel将棋：クラスの設計、こちらを参照してください。
・作成するクラスの役割と作成順 ・作成するクラスのメンバー一覧 ・駒の移動の定義 ・Excel将棋の目次
※クラス名、プロシージャー名、変数名に日本語を使用しています。
デフォルトインスタンスに変更する理由と方法
cls位置は、あちこちで頻繁に使用するクラスになります。
使うたびにNewしなければならないのは、かなり面倒です。
そこで、グローバルなデフォルトインスタンスにしてしまう事でVBA記述を簡単にしてしまおうという事です。
さらに、メソッド・プロパティの記述も面倒なので、既定メンバーを設定してクラスを使うVBAを極力簡単な記述します。
デフォルトインスタンスと規定メンバーの設定については以下で解説しています。
使うたびにNewしなければならないのは、かなり面倒です。
そこで、グローバルなデフォルトインスタンスにしてしまう事でVBA記述を簡単にしてしまおうという事です。
さらに、メソッド・プロパティの記述も面倒なので、既定メンバーを設定してクラスを使うVBAを極力簡単な記述します。
デフォルトインスタンスと規定メンバーの設定については以下で解説しています。
VBAクラスのAttributeについて（既定メンバーとFor Each）
・VBAクラスのエクスポートとインポート ・Attribute VB_PredeclaredId ・Attribute VB_Exposed ・Attribute [procName.]VB_Description ・Attribute variableName.VB_VarUserMemId ・Attribute procName.VB_UserMemId = 0 ・Attribute procName.VB_UserMemId = -4 ・VBAクラスのAttributeの最後に
この変更に伴い、クラス名も
cls位置 → g位置
と変更することにします。
・クラス名をg位置に変更
・NewPosを作成
cls位置 → g位置
と変更することにします。
・NewPosを作成
Function NewPos(Optional ByVal arg行 As Variant, _
Optional ByVal arg列 As Variant) As g位置
Dim obj位置 As New g位置
If Not (IsMissing(arg行) Or IsMissing(arg列)) Then
obj位置.行 = arg行
obj位置.列 = arg列
End If
Set NewPos = obj位置
End Function
・g位置を解放&エクスポート
・エクスポートしたg位置.clsを編集
・エクスポートしたg位置.clsを編集
Attribute VB_PredeclaredId = False
↓
Attribute VB_PredeclaredId = True
Function NewPos(・・・
この下に、
Attribute NewPos.VB_Description = "クラスの既定のメンバー"
Attribute NewPos.VB_UserMemId = 0
この2行を追加
↓
Attribute VB_PredeclaredId = True
この下に、
Attribute NewPos.VB_Description = "クラスの既定のメンバー"
Attribute NewPos.VB_UserMemId = 0
この2行を追加
・g位置.clsをインポート
位置クラスのインポート用ソース
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
END
Attribute VB_Name = "g位置"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public 行 As Integer
Public 列 As Integer
Function NewPos(Optional ByVal arg行 As Variant, _
Optional ByVal arg列 As Variant) As cls位置
Attribute NewPos.VB_Description = "クラスの既定のメンバー"
Attribute NewPos.VB_UserMemId = 0
Dim obj位置 As New g位置
If Not (IsMissing(arg行) Or IsMissing(arg列)) Then
obj位置.行 = arg行
obj位置.列 = arg列
End If
Set NewPos = obj位置
End Function
cls位置とg位置の使い方の違い
変更前のcls位置の使い方
Dim obj位置 As New cls位置
obj位置.行 = arg行
obj位置.列 = arg列
Set Me.駒位置 = obj位置
変更後のg位置の使い方
Set Me.駒位置 = g位置(arg行, arg列)
これにより、プロパティの設定や関数の引数に直接記述できるようになっています。
Asで型として指定する部分は名称変更だけになります。
位置クラス変更に伴う駒クラスの変更
位置クラスの変更に伴い、駒クラスを変更しました。
変更箇所は太字にしています。
駒クラスが変更になったので、テストVBAコードも変更してテスト確認しておきます。
修正前と同じ結果になっていることを確認します。
変更箇所は太字にしています。
Option Explicit
Private p正式名称 As String
Private p表示名称 As String
Private p成駒名称 As String
Private p表示順 As Integer
Private p先手 As Boolean
Private p成り As Boolean
Private p駒位置 As g位置
Private p駒移動() As cls移動
Private p成駒移動() As cls移動
'**********************************************************************
' 駒の名称や動きの定義
'**********************************************************************
'正式名称,表示名称,成駒名称,表示順
Private Const cns王将定義 As String = "王将,玉, ,0"
Private Const cns飛車定義 As String = "飛車,飛,龍,1"
Private Const cns角行定義 As String = "角行,角, ,2"
Private Const cns金将定義 As String = "金将,金, ,3"
Private Const cns銀将定義 As String = "銀将,銀,全,4"
Private Const cns桂馬定義 As String = "桂馬,桂,圭,5"
Private Const cns香車定義 As String = "香車,香,杏,6"
Private Const cns歩兵定義 As String = "歩兵,歩,と,7"
'行,列,回数
Private Const cns王将移動 As String = "-1,-1, 1;" & _
"-1, 0, 1;" & _
"-1, 1, 1;" & _
" 0,-1, 1;" & _
" 0, 1, 1;" & _
" 1,-1, 1;" & _
" 1, 0, 1;" & _
" 1, 1, 1;"
Private Const cns飛車移動 As String = "-1, 0, 8;" & _
" 1, 0, 8;" & _
" 0,-1, 8;" & _
" 0, 1, 8;"
Private Const cns龍王移動 As String = "-1, 0, 8;" & _
" 1, 0, 8;" & _
" 0,-1, 8;" & _
" 0, 1, 8;" & _
"-1,-1, 1;" & _
"-1, 1, 1;" & _
" 1,-1, 1;" & _
" 1, 1, 1;"
Private Const cns角行移動 As String = "-1,-1, 8;" & _
"-1, 1, 8;" & _
" 1,-1, 8;" & _
" 1, 1, 8;"
Private Const cns龍馬移動 As String = "-1,-1, 8;" & _
"-1, 1, 8;" & _
" 1,-1, 8;" & _
" 1, 1, 8;" & _
"-1,-1, 1;" & _
"-1, 1, 1;" & _
" 1,-1, 1;" & _
" 1, 1, 1;"
Private Const cns金将移動 As String = "-1,-1, 1;" & _
"-1, 0, 1;" & _
"-1, 1, 1;" & _
" 0,-1, 1;" & _
" 0, 1, 1;" & _
" 1, 0, 1;"
Private Const cns銀将移動 As String = "-1,-1, 1;" & _
"-1, 0, 1;" & _
"-1, 1, 1;" & _
" 1,-1, 1;" & _
" 1, 1, 1;"
Private Const cns桂馬移動 As String = "-2,-1, 1;" & _
"-2, 1, 1;"
Private Const cns香車移動 As String = "-1, 0, 8;"
Private Const cns歩兵移動 As String = "-1,-1, 1;"
Private Sub Class_Initialize()
'引数省略した場合でも()を付ける必要があります。
'()を付けないと既定のメンバーが呼び出されない
Set p駒位置 = g位置()
End Sub
'**********************************************************************
' 公開プロパティ
'**********************************************************************
Public Property Let 正式名称(ByVal Value As String)
p正式名称 = Value
End Property
Public Property Get 正式名称() As String
正式名称 = p正式名称
End Property
Public Property Let 表示名称(ByVal Value As String)
p表示名称 = Value
End Property
Public Property Get 表示名称() As String
表示名称 = IIf(Me.成り, p成駒名称, p表示名称)
End Property
Public Property Let 成駒名称(ByVal Value As String)
p成駒名称 = Value
End Property
Public Property Get 成駒名称() As String
成駒名称 = p成駒名称
End Property
Public Property Let 表示順(ByVal Value As String)
p表示順 = Value
End Property
Public Property Get 表示順() As String
表示順 = p表示順
End Property
Public Property Let 駒移動(ByRef arg移動() As cls移動)
p駒移動 = arg移動
End Property
Public Property Get 駒移動() As cls移動()
駒移動 = p駒移動
End Property
Public Property Let 成駒移動(ByRef arg移動() As cls移動)
p成駒移動 = arg移動
End Property
Public Property Get 成駒移動() As cls移動()
成駒移動 = p成駒移動
End Property
Public Property Let 先手(ByVal Value As Boolean)
p先手 = Value
End Property
Public Property Get 先手() As Boolean
先手 = p先手
End Property
Public Property Let 成り(ByVal Value As Boolean)
p成り = Value
End Property
Public Property Get 成り() As Boolean
成り = p成り
End Property
Public Property Set 駒位置(ByVal arg駒位置 As g位置)
Set p駒位置 = arg駒位置
End Property
Public Property Get 駒位置() As g位置
Set 駒位置 = p駒位置
End Property
'**********************************************************************
' 公開メソッド
'**********************************************************************
'駒の正式名称を受け取って、その駒特有の情報を設定する
Public Function 駒作成(ByVal arg名称 As String, _
ByVal arg先手 As Boolean, _
Optional ByVal arg位置 As g位置 = Nothing _
) As cls駒
Dim tmp定義 As String
Dim tmp移動 As String, tmp成移動 As String
Select Case arg名称
Case "王将", "玉将", "王", "玉"
tmp定義 = cns王将定義
tmp移動 = cns王将移動
tmp成移動 = "" '成れない
Case "飛車", "飛"
tmp定義 = cns飛車定義
tmp移動 = cns飛車移動
tmp成移動 = cns龍王移動
Case "角行", "角"
tmp定義 = cns角行定義
tmp移動 = cns角行移動
tmp成移動 = cns龍馬移動
Case "金将", "金"
tmp定義 = cns金将定義
tmp移動 = cns金将移動
tmp成移動 = "" '成れない
Case "銀将", "銀"
tmp定義 = cns銀将定義
tmp移動 = cns銀将移動
tmp成移動 = cns金将移動
Case "桂馬", "桂"
tmp定義 = cns桂馬定義
tmp移動 = cns桂馬移動
tmp成移動 = cns金将移動
Case "香車", "香"
tmp定義 = cns香車定義
tmp移動 = cns香車移動
tmp成移動 = cns金将移動
Case "歩兵", "歩"
tmp定義 = cns歩兵定義
tmp移動 = cns歩兵移動
tmp成移動 = cns金将移動
Case Else
Err.Raise 9999 '形式的に記述
End Select
Dim sSplit() As String
sSplit = Split(tmp定義, ",")
Me.正式名称 = sSplit(0)
Me.表示名称 = sSplit(1)
Me.成駒名称 = sSplit(2)
Me.表示順 = sSplit(3)
Me.駒移動 = 駒移動設定(tmp移動)
Me.成駒移動 = 駒移動設定(tmp成移動)
Me.先手 = arg先手
Set Me.駒位置 = arg位置
Set 駒作成 = Me
End Function
'g位置により不要になりました
'駒位置プロパティの設定を行・列で行う
'Public Sub 駒位置設定(ByVal arg行 As Integer, _
' ByVal arg列 As Integer)
' Dim obj位置 As New g位置
' obj位置.行 = arg行
' obj位置.列 = arg列
' Set Me.駒位置 = obj位置
'End Sub
'駒が移動できる位置をg位置（行、列）のCollectionで返す
Public Function 駒移動可能位置(ary盤面) As Collection
Dim col位置 As New Collection
Dim tmp移動 As Variant 'For Eachで使用する都合でVariant
Dim tmp位置 As g位置
Dim i As Long
For Each tmp移動 In IIf(Me.成り, Me.成駒移動, Me.駒移動)
For i = 1 To tmp移動.回数
Set tmp位置 = g位置() '()は省略できない
'先手後手で進む方向を反転させる
tmp位置.行 = Me.駒位置.行 + (tmp移動.行 * i * IIf(Me.先手, 1, -1))
tmp位置.列 = Me.駒位置.列 + (tmp移動.列 * i * IIf(Me.先手, 1, -1))
'盤外に出たら内側のForのみ抜ける
If tmp位置.行 < LBound(ary盤面, 1) Or _
tmp位置.行 > UBound(ary盤面, 1) Or _
tmp位置.列 < LBound(ary盤面, 2) Or _
tmp位置.列 > UBound(ary盤面, 2) Then
Exit For
End If
If ary盤面(tmp位置.行, tmp位置.列) Is Nothing Then
'駒が無いので駒を置ける
col位置.Add tmp位置
Else
'相手の駒なら取れる、自分の駒ならそれ以上進めない
If ary盤面(tmp位置.行, tmp位置.列).先手 <> Me.先手 Then
col位置.Add tmp位置
End If
Exit For
End If
Next
Next
Set 駒移動可能位置 = col位置
End Function
'**********************************************************************
' 非公開メソッド
'**********************************************************************
'駒の動きを定義したConstより配列を作成する
Private Function 駒移動設定(ByVal arg動き As String) As cls移動()
Dim ary移動() As cls移動
Dim tmp移動 As cls移動
Dim sSplit1() As String, sSplit2() As String
Dim i As Long, j As Long
'行,列,回数;行,列,回数;・・・; 最後は;で終わる前提
sSplit1 = Split(arg動き, ";")
If UBound(sSplit1) < 0 Then Exit Function '成らない駒
ReDim ary移動(LBound(sSplit1) To UBound(sSplit1) - 1)
For i = LBound(sSplit1) To UBound(sSplit1) - 1
sSplit2 = Split(sSplit1(i), ",")
Set tmp移動 = New cls移動
tmp移動.行 = sSplit2(LBound(sSplit2) + 0)
tmp移動.列 = sSplit2(LBound(sSplit2) + 1)
tmp移動.回数 = sSplit2(LBound(sSplit2) + 2)
Set ary移動(i) = tmp移動
Next
駒移動設定 = ary移動
End Function
駒クラスが変更になったので、テストVBAコードも変更してテスト確認しておきます。
Sub test1()
Const 先手 As Boolean = True
Const 後手 As Boolean = False
ReDim ary盤(1 To 9, 1 To 9) As cls駒
Call 着手(ary盤, g位置(5, 5), "飛車", 先手)
Call 着手(ary盤, g位置(7, 5), "金将", 先手)
Call 着手(ary盤, g位置(5, 8), "歩兵", 先手)
Call 着手(ary盤, g位置(9, 9), "香車", 先手)
Call 着手(ary盤, g位置(2, 5), "歩兵", 先手)
ary盤(2, 5).成り = True
Call 着手(ary盤, g位置(4, 4), "銀将", 後手)
Call 着手(ary盤, g位置(3, 5), "歩兵", 後手)
Call 着手(ary盤, g位置(2, 8), "角行", 後手)
Call Print盤(ary盤)
Debug.Print vbLf; ary盤(5, 5).表示名称 & "(5, 5)"
Call PrintArray(col位置2Array(ary盤(5, 5).駒移動可能位置(ary盤)))
Debug.Print vbLf; ary盤(2, 5).表示名称 & "(2, 5)"
Call PrintArray(col位置2Array(ary盤(2, 5).駒移動可能位置(ary盤)))
Debug.Print vbLf; ary盤(9, 9).表示名称 & "(9, 9)"
Call PrintArray(col位置2Array(ary盤(9, 9).駒移動可能位置(ary盤)))
Debug.Print vbLf; ary盤(2, 8).表示名称 & "(2, 8)"
Call PrintArray(col位置2Array(ary盤(2, 8).駒移動可能位置(ary盤)))
Debug.Print vbLf; ary盤(4, 4).表示名称 & "(4, 4)"
Call PrintArray(col位置2Array(ary盤(4, 4).駒移動可能位置(ary盤)))
End Sub
Private Function 着手(ByRef ary() As cls駒, _
ByVal arg位置 As g位置, _
ByVal 駒名 As String, _
ByVal 先手 As Boolean) As cls駒
Dim obj駒 As New cls駒
Call obj駒.駒作成(駒名, 先手, arg位置)
Set ary(arg位置.行, arg位置.列) = obj駒
'駒作成の戻りを使って、以下のように記述できます。
'Set ary(行, 列) = obj駒.駒作成(駒名, 先手, 行, 列)
'さらに、以下いずれかの方法でDimも書かずに1行で記述することも可能
'Set ary(行, 列) = VBA.CVar(New cls駒).駒作成(駒名, 先手, 行, 列)
'Set ary(行, 列) = CallByName(New cls駒, "駒作成", VbMethod, 駒名, 先手, 行, 列)
End Function
Sub Print盤(ByRef ary盤() As cls駒, Optional separator As String = "")
Dim i As Long, j As Long
Dim sTemp As String, sPrint As String
For i = LBound(ary盤, 1) To UBound(ary盤, 1)
sPrint = ""
For j = LBound(ary盤, 2) To UBound(ary盤, 2)
If ary盤(i, j) Is Nothing Then
sTemp = "・ "
Else
sTemp = ary盤(i, j).表示名称
sTemp = sTemp & IIf(ary盤(i, j).先手, "↑", "↓")
End If
sPrint = sPrint & sTemp & separator
Next
Debug.Print sPrint
Next
End Sub
Function col位置2Array(ByVal col位置 As Collection) As Variant
Dim ary(1 To 9, 1 To 9) As Integer
Dim obj位置 As g位置
For Each obj位置 In col位置
ary(obj位置.行, obj位置.列) = 1
Next
col位置2Array = ary
End Function
Sub PrintArray(ByRef ary, Optional separator As String = "")
Dim i As Long, j As Long, str As String
For i = LBound(ary, 1) To UBound(ary, 1)
str = ""
For j = LBound(ary, 2) To UBound(ary, 2)
If j > LBound(ary, 2) Then str = str & separator
str = str & ary(i, j)
Next
Debug.Print str
Next
End Sub
修正前と同じ結果になっていることを確認します。
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将棋の目次
新着記事NEW ・・・新着記事一覧を見る
ブール型（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)
複数の文字列を検索して置換するSUBSTITUTE｜エクセル入門(2024-01-03)
いくつかの数式の計算中にリソース不足になりました。｜エクセル雑感(2023-12-28)
アクセスランキング ・・・ ランキング一覧を見る
1.最終行の取得（End,Rows.Count）｜VBA入門
2.セルのコピー&値の貼り付け（PasteSpecial）｜VBA入門
3.RangeとCellsの使い方｜VBA入門
4.ひらがな⇔カタカナの変換｜エクセル基本操作
5.繰り返し処理（For Next)｜VBA入門
6.変数宣言のDimとデータ型｜VBA入門
7.ブックを閉じる・保存（Close,Save,SaveAs）｜VBA入門
8.並べ替え（Sort）｜VBA入門
9.セルのクリア（Clear,ClearContents）｜VBA入門
10.Findメソッド（Find,FindNext,FindPrevious）｜VBA入門
- ホーム
- マクロVBA応用編
- マクロVBAサンプル集
- Excel将棋：位置クラスをデフォルトインスタンスに変更(№6)
このサイトがお役に立ちましたら「シェア」「Bookmark」をお願いいたします。
記述には細心の注意をしたつもりですが、
間違いやご指摘がありましたら、「お問い合わせ」からお知らせいただけると幸いです。
掲載のVBAコードは動作を保証するものではなく、あくまでVBA学習のサンプルとして掲載しています。
掲載のVBAコードは自己責任でご使用ください。万一データ破損等の損害が発生しても責任は負いません。