VBAサンプル集
Excel囲碁:再起動後も続けて打てるように改造

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

Excel囲碁:再起動後も続けて打てるように改造


VBA マクロ Excel囲碁

Excelで囲碁を作ってみます。
人vs人で対戦できる程度、単純に黒白交互に打っていけるものです。
前作ではその場で打てればよいだけで作成しましたが、
1日1ツイートで先生とフォロワーで対戦していくことになりました。
そこで、日々初手から打っていくのでは大変なので、前回保存状態から打ち続けられるように改造しました。

前作については以下をご覧ください。

Excel囲碁:万波奈穂先生に捧ぐ
Excelで囲碁を作ってみます。AI搭載とかそんな大層なものではありません。人vs人で対戦できる程度、単純に黒白交互に打っていけるものです。ただし、・相手の石を囲んだら相手の石を取るのは自動にします。・着手禁止点には着手できないようにします。

ツイッターで日々使っていくので、その過程でさらに改良していくことになると思います。
変更は随時こちらに掲載していく予定です。

更新履歴

更新日 更新内容 
2020/8/22 星を付けました。
路盤数に一般的な位置に星をつけるようにしています。
2020/8/25 石の上に手数の数字を表示しました。
「№消去」でそれまでの手数表示を消すことができます。

以下に掲載のVBAコートおよび、以下のダウンロードは常に更新後の最新にしてあります。
excel_igo2.zip excel_igo2.xlsm

Excel囲碁の今回の改造のきっかけ

これを作るきっかけとなったのは、
万波奈穂@naonao_myu
こちらの先生のツイート

マクロ VBA サンプル画像

ツイートはハッシュタグ、
#1日1ツイートで囲碁ルールを説明したら何日で伝えられるか

Excel囲碁の今回の改造点

VBA マクロ Excel囲碁


各種情報を表示し引き継ぎやすいように、
シート内の開始位置は固定にしました。

以下の情報をシートに表示するようにしました。

・路盤数
・手数
・コウ
・棋譜

これにより、ブックを保存し閉じた後でも、再度ブックを開けば続けて打っていくことができるようになりました。
また、シートそのものをコピーすれば、コピー先のシートでも打ち続けられます。
もちろん元のシートでも打ち続けられます。
ただし、「待った」で戻せるのは再開後だけになります。
この辺りは、Excelの「元に戻す」と同じようなものだと考えてください。

さらに追加機能として、
「盤面コピー」を追加しました。
ボタンクリックすると、

VBA マクロ Excel囲碁

ツイッターに「Ctrl + C」で貼り付けできます。

Excel囲碁の全VBAコード

Option Explicit

Public Const c碁盤色 = &H75DEFF 'RGB(255, 222, 117)
Public Const c開始位置 = "C2"

Public g路盤数 As Integer '9,13,15,19
Public g碁盤幅 As Long 'ピクセル指定

Public gWS As Worksheet
Public g先手アゲハマ As Range
Public g後手アゲハマ As Range

Public g手数
Public gCols配列
Public gCols先手アゲハマ
Public gCols後手アゲハマ

Public gStrコウ

Enum e碁石
  無
  黒
  白
End Enum

'**********************************************************************
' ゲーム進行の制御メイン
'**********************************************************************

Sub ゲーム開始()
  Dim inputStr
start:
  inputStr = InputBox("路盤数を指定してください。" & vbLf & vbLf & _
            "続けてカンマ(,)の後ろに1路の幅をビクセルで指定できます。" & vbLf & _
            "例." & vbLf & _
            "9" & vbLf & _
            "9,60", "碁盤初期設定")
  If inputStr = "" Then Exit Sub
  Dim sSplit: sSplit = Split(inputStr, ",")
  Dim i
  For i = 0 To UBound(sSplit)
    If Not IsNumeric(sSplit(0)) Then
      GoTo start
    End If
  Next
  g路盤数 = sSplit(0)
  If UBound(sSplit) = 0 Then
    g碁盤幅 = 550 / g路盤数
  Else
    g碁盤幅 = sSplit(1)
  End If
  
  ActiveWindow.DisplayGridlines = False
  Set gWS = ActiveSheet
  Dim myRange
  Set myRange = gWS.Range(c開始位置)
  
  Application.ScreenUpdating = False
  
  Set gWS = myRange.Worksheet
  シート設定 myRange
  引継情報場所
  アゲハマ場所作成 myRange
  碁盤座標 myRange
  碁石作成 myRange
  星作成 myRange
  
  g手数 = 0
  Set gCols配列 = New Collection
  Set gCols先手アゲハマ = New Collection
  Set gCols後手アゲハマ = New Collection
  gCols配列.Add 配列作成, CStr(g手数)
  gCols先手アゲハマ.Add "", CStr(g手数)
  gCols後手アゲハマ.Add "", CStr(g手数)
  gStrコウ = ""
  gWS.Range("手番") = "●先手番です"
  盤面保存
  
  Application.ScreenUpdating = True
End Sub

Sub パス()
  盤面再開
  g手数 = g手数 + 1
  gCols配列.Add 配列作成, CStr(g手数)
  gCols先手アゲハマ.Add g先手アゲハマ.Value, CStr(g手数)
  gCols後手アゲハマ.Add g先手アゲハマ.Value, CStr(g手数)
  gWS.Range("手番") = IIf(先手, "◯後手番です", "●先手番です") '次の手番
  盤面保存
End Sub

Sub 待った()
  盤面再開
  If g手数 = 0 Then Exit Sub
  If Not IsArray(gCols配列(CStr(g手数 - 1))) Then
    MsgBox "これ以上は待ったはできません。"
    Exit Sub
  End If
  
  Dim sp碁石, i, j
  For Each sp碁石 In gWS.Shapes
    If sp碁石.Name Like "碁石*" Then
      碁石Index sp碁石, i, j
      Select Case gCols配列(CStr(g手数 - 1))(i, j)
        Case e碁石.黒
          sp碁石.Fill.Transparency = 0
          sp碁石.Fill.ForeColor.RGB = vbBlack
        Case e碁石.白
          sp碁石.Fill.Transparency = 0
          sp碁石.Fill.ForeColor.RGB = vbWhite
        Case e碁石.無
          sp碁石.Fill.Transparency = 1
      End Select
    End If
  Next
  gCols配列.Remove CStr(g手数)
  
  手数再表示
  
  g先手アゲハマ.Value = gCols先手アゲハマ(g手数)
  g後手アゲハマ.Value = gCols後手アゲハマ(g手数)
  gCols先手アゲハマ.Remove CStr(g手数)
  gCols後手アゲハマ.Remove CStr(g手数)
  
  g手数 = g手数 - 1
  
  盤面保存
  gWS.Range("棋譜").Offset(1).Delete Shift:=xlUp
End Sub

Sub 盤面コピー()
  盤面再開
  gWS.Range(c開始位置).Resize(g路盤数 + 1, g路盤数 + 1).CopyPicture Format:=xlBitmap
  MsgBox "盤面をクリップボードにコピーしました。"
End Sub

Sub 打つ()
  盤面再開
  Dim sp碁石: Set sp碁石 = gWS.Shapes(Application.Caller)
  
  If 碁石判別(sp碁石) <> e碁石.無 Then
    Exit Sub
  End If
  
  If コウ判定(sp碁石) Then
    Exit Sub
  End If
  
  g手数 = g手数 + 1
  
  sp碁石.Fill.ForeColor.RGB = IIf(先手, vbBlack, vbWhite)
  sp碁石.Fill.Transparency = 0
  相手碁石確認 sp碁石
  
  gCols配列.Add 配列作成, CStr(g手数)
  gCols先手アゲハマ.Add g先手アゲハマ.Value, CStr(g手数)
  gCols後手アゲハマ.Add g先手アゲハマ.Value, CStr(g手数)
  
  着手禁止点 sp碁石
  
  手数表示 sp碁石
  棋譜追加 sp碁石
  盤面保存
End Sub

'**********************************************************************
' メインから呼ばれるSubとFunction
'**********************************************************************

Sub 棋譜追加(sp碁石)
  Dim i, j
  碁石Index sp碁石, i, j
  gWS.Range("棋譜").Offset(1).Insert Shift:=xlDown
  gWS.Range("棋譜").Offset(1) = g手数 & ". " & _
                 StrConv(j, vbWide) & _
                 WorksheetFunction.Text(i, "[DBNum1]0") & _
                 IIf(先手, "●", "◯")
  gWS.Range("手番") = IIf(先手, "◯後手番です", "●先手番です") '次の手番
End Sub

Sub 盤面保存()
  With gWS
    .Range("路盤数") = g路盤数
    .Range("手数") = g手数
    .Range("コウ") = "'" & gStrコウ
  End With
End Sub

Sub 盤面再開()
  If gWS Is ActiveSheet Then Exit Sub
  
  Set gWS = ActiveSheet
  
  On Error Resume Next
  If gWS.Range("手数") = "" Or gWS.Range("路盤数") = "" Then
    MsgBox "情報がありません。" & vbLf & "ゲーム開始からやり直してください。"
    Exit Sub
  End If
  If Err Then
    MsgBox "情報がありません。" & vbLf & "ゲーム開始からやり直してください。"
    Exit Sub
  End If
  On Error GoTo 0
  
  With gWS
    g手数 = .Range("手数")
    g路盤数 = .Range("路盤数")
    Set g先手アゲハマ = .Range("先手アゲハマ")
    Set g後手アゲハマ = .Range("後手アゲハマ")
    gStrコウ = .Range("コウ")
  End With
  
  Set gCols配列 = New Collection
  Set gCols先手アゲハマ = New Collection
  Set gCols後手アゲハマ = New Collection
  
  Dim i As Long
  For i = 0 To g手数 - 1
    gCols配列.Add "", CStr(i)
    gCols先手アゲハマ.Add "", CStr(i)
    gCols後手アゲハマ.Add "", CStr(i)
  Next
  gCols配列.Add 配列作成, CStr(g手数)
  gCols先手アゲハマ.Add g先手アゲハマ.Value, CStr(g手数)
  gCols後手アゲハマ.Add g先手アゲハマ.Value, CStr(g手数)
End Sub

Function 先手()
  先手 = CBool(g手数 Mod 2)
End Function

Function コウ判定(sp碁石)
  Dim i, j
  碁石Index sp碁石, i, j
  If gStrコウ = 文字列Index(i, j) Then
    MsgBox "コウなので打てません。"
    コウ判定 = True
    Exit Function
  End If
  gStrコウ = ""
End Function

Sub 着手禁止点(sp碁石)
  Dim y, x, tValue, rtn
  碁石Index sp碁石, y, x
  Dim ary: ary = 配列作成
  rtn = True
  相手碁石何奪取 ary, y, x, IIf(先手, e碁石.黒, e碁石.白), rtn
  If rtn Then
    MsgBox "着手禁止点です。"
    待った
  End If
End Sub

Sub 相手碁石確認(sp碁石)
  Dim y, x, ary, tValue, rtn
  
  碁石Index sp碁石, y, x
  tValue = IIf(先手, e碁石.白, e碁石.黒) '相手碁石
  
  If y > 1 Then
    ary = 配列作成
    If ary(y - 1, x) = tValue Then
      rtn = True
      相手碁石何奪取 ary, y - 1, x, tValue, rtn
      If rtn Then 相手碁石奪取 ary
    End If
  End If
  If y < g路盤数 Then
    ary = 配列作成
    If ary(y + 1, x) = tValue Then
      rtn = True
      相手碁石何奪取 ary, y + 1, x, tValue, rtn
      If rtn Then 相手碁石奪取 ary
    End If
  End If
  If x > 1 Then
    ary = 配列作成
    If ary(y, x - 1) = tValue Then
      rtn = True
      相手碁石何奪取 ary, y, x - 1, tValue, rtn
      If rtn Then 相手碁石奪取 ary
    End If
  End If
  If x < g路盤数 Then
    ary = 配列作成
    If ary(y, x + 1) = tValue Then
      rtn = True
      相手碁石何奪取 ary, y, x + 1, tValue, rtn
      If rtn Then 相手碁石奪取 ary
    End If
  End If
End Sub

Sub 相手碁石何奪取(ary, y, x, tValue, rtn)
  If rtn = False Then Exit Sub
  ary(y, x) = 9
  
  If y > 1 Then
    If ary(y - 1, x) = 0 Then
      rtn = False: Exit Sub
    ElseIf ary(y - 1, x) = tValue Then
      相手碁石何奪取 ary, y - 1, x, tValue, rtn
    End If
  End If
  If y < g路盤数 Then
    If ary(y + 1, x) = 0 Then
      rtn = False: Exit Sub
    ElseIf ary(y + 1, x) = tValue Then
      相手碁石何奪取 ary, y + 1, x, tValue, rtn
    End If
  End If
  If x > 1 Then
    If ary(y, x - 1) = 0 Then
      rtn = False: Exit Sub
    ElseIf ary(y, x - 1) = tValue Then
      相手碁石何奪取 ary, y, x - 1, tValue, rtn
    End If
  End If
  If x < g路盤数 Then
    If ary(y, x + 1) = 0 Then
      rtn = False: Exit Sub
    ElseIf ary(y, x + 1) = tValue Then
      相手碁石何奪取 ary, y, x + 1, tValue, rtn
    End If
  End If
End Sub

Sub 相手碁石奪取(ary)
  gStrコウ = ""
  Dim sp, i, j
  For i = LBound(ary, 1) To UBound(ary, 1)
    For j = LBound(ary, 2) To UBound(ary, 2)
      If ary(i, j) = 9 Then
        Set sp = gWS.Shapes("碁石" & Format(i, "00") & Format(j, "00"))
        sp.Fill.Transparency = 1
        If 先手 Then
          g先手アゲハマ = g先手アゲハマ & "●"
        Else
          g後手アゲハマ = g後手アゲハマ & "●"
        End If
        gStrコウ = gStrコウ & 文字列Index(i, j)
        DoEvents
        Application.Wait [now()+"0:0:0.1"]
      End If
    Next
  Next
  If Len(gStrコウ) > 4 Then gStrコウ = ""
End Sub

Function 碁石判別(sp碁石) As e碁石
  Select Case True
    Case sp碁石.Fill.Transparency = 1
      碁石判別 = 無
    Case sp碁石.Fill.ForeColor.RGB = vbBlack
      碁石判別 = 黒
    Case sp碁石.Fill.ForeColor.RGB = vbWhite
      碁石判別 = 白
  End Select
End Function

Function 配列作成()
  ReDim ary(1 To g路盤数, 1 To g路盤数)
  Dim sp碁石, i, j
  For Each sp碁石 In gWS.Shapes
    If sp碁石.Name Like "碁石*" Then
      Call 碁石Index(sp碁石, i, j)
      ary(i, j) = 碁石判別(sp碁石)
    End If
  Next
  配列作成 = ary
End Function

Sub 碁石Index(sp碁石, i, j)
  i = CLng(Mid(sp碁石.Name, 3, 2))
  j = CLng(Mid(sp碁石.Name, 5, 2))
End Sub

Function 文字列Index(i, j)
  文字列Index = Format(i, "00") & Format(j, "00")
End Function

'**********************************************************************
' ゲーム進行の制御メイン
'**********************************************************************

Sub 手数表示(sp碁石)
  Dim sp
  Set sp = gWS.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, sp碁石.Width * 2, sp碁石.Height)
  sp.Name = "手数" & sp碁石.Name
  sp.Top = sp碁石.Top
  sp.Left = sp碁石.Left - (sp碁石.Width / 2)
  sp.Fill.Visible = msoFalse
  sp.Line.Visible = msoFalse
  sp.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = IIf(先手, vbWhite, vbBlack)
  sp.TextFrame2.TextRange.Characters.Text = g手数
  Select Case g路盤数
    Case Is <= 9
      sp.TextFrame2.TextRange.Font.Size = 20
    Case Is <= 13
      sp.TextFrame2.TextRange.Font.Size = 14
    Case Is <= 15
      sp.TextFrame2.TextRange.Font.Size = 11
    Case Else
      sp.TextFrame2.TextRange.Font.Size = 9
  End Select
  sp.TextFrame2.VerticalAnchor = msoAnchorMiddle
  sp.TextFrame2.HorizontalAnchor = msoAnchorCenter
  
  手数再表示
End Sub

Sub 手数再表示()
  On Error Resume Next
  Dim sp碁石
  For Each sp碁石 In gWS.Shapes
    If sp碁石.Name Like "碁石*" Then
      Select Case sp碁石.Fill.Transparency
        Case 1
          gWS.Shapes("手数" & sp碁石.Name).Delete
      End Select
    End If
  Next
  On Error GoTo 0
End Sub

Sub 手数消去()
  Dim sp
  For Each sp In gWS.Shapes
    If sp.Name Like "手数*" Then
      sp.Delete
    End If
  Next
End Sub

'**********************************************************************
' シート作成
'**********************************************************************

Sub シート設定(argRng)
  argRng.Worksheet.Protect UserInterfaceOnly:=True
  argRng.Worksheet.Cells.Clear
  ClearShapes argRng.Worksheet
  
  With argRng.Resize(g路盤数 + 1, g路盤数 + 1)
    ColumnWidthPixcel .Cells, CLng(g碁盤幅)
    RowHeightPixcel .Cells, CLng(g碁盤幅)
    .Interior.Color = c碁盤色
  End With
  
  With argRng.Offset(1, 1).Resize(g路盤数 - 1, g路盤数 - 1)
    .Borders.LineStyle = xlContinuous
    .Borders.Weight = xlMedium
  End With
  
  argRng.Worksheet.Protect UserInterfaceOnly:=True
End Sub

Sub 引継情報場所()
  With gWS
    .Names.Add Name:="手番", RefersToLocal:=.Range("A3")
    .Names.Add Name:="路盤数", RefersToLocal:=.Range("A4")
    .Names.Add Name:="手数", RefersToLocal:=.Range("A5")
    .Names.Add Name:="コウ", RefersToLocal:=.Range("A6")
    .Names.Add Name:="棋譜", RefersToLocal:=.Range("A7")
    .Range("路盤数").NumberFormatLocal = """路盤数:""#"
    .Range("手数").NumberFormatLocal = """手数:""#"
    .Range("コウ").NumberFormatLocal = """コウ:""@"
    .Range("路盤数").HorizontalAlignment = xlLeft
    .Range("手数").HorizontalAlignment = xlLeft
    .Range("コウ").HorizontalAlignment = xlLeft
  End With
End Sub

Sub アゲハマ場所作成(argRng)
  Set g先手アゲハマ = argRng.Offset(g路盤数, g路盤数 + 1)
  argRng.Worksheet.Names.Add Name:="先手アゲハマ", RefersToLocal:=g先手アゲハマ
  アゲハマ場所共通 g先手アゲハマ, vbBlack, vbWhite
  
  Set g後手アゲハマ = argRng.Offset(, -1)
  argRng.Worksheet.Names.Add Name:="後手アゲハマ", RefersToLocal:=g後手アゲハマ
  アゲハマ場所共通 g後手アゲハマ, vbWhite, vbBlack
  
  ColumnWidthPixcel g先手アゲハマ.EntireColumn, CLng(g碁盤幅) * 2
  ColumnWidthPixcel g後手アゲハマ.EntireColumn, CLng(g碁盤幅) * 2
End Sub

Sub アゲハマ場所共通(argRng, argColor1, argColor2)
  With argRng
    .Font.Color = argColor2
    .Font.Bold = True
    .WrapText = True
    .Interior.Color = argColor1
    .HorizontalAlignment = xlCenter
    .BorderAround xlContinuous, xlThick, , argColor2
  End With
End Sub

Sub 碁盤座標(argRng)
  Dim sp, i
  For i = 1 To g路盤数
    With 碁盤座標共通(argRng)
      .TextFrame2.TextRange.Characters.Text = i
      .Top = argRng.Offset(, i).Top - PixcelToPoint(g碁盤幅 / 8)
      .Left = argRng.Offset(, i).Left - PixcelToPoint(g碁盤幅 / 2)
      .Name = "座標横" & i
    End With
    With 碁盤座標共通(argRng)
      .TextFrame2.TextRange.Characters.Text = WorksheetFunction.Text(i, "[DBNum1]0")
      .Top = argRng.Offset(i - 1).Top + PixcelToPoint(g碁盤幅 / 2)
      .Left = argRng.Offset(i - 1).Left - PixcelToPoint(g碁盤幅 / 8)
      .Name = "座標縦" & i
    End With
  Next
End Sub

Function 碁盤座標共通(argRng)
  Dim sp
  Set sp = argRng.Worksheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 0, 0, PixcelToPoint(g碁盤幅) - 2, PixcelToPoint(g碁盤幅) - 2)
  With sp
    .TextFrame2.TextRange.Characters.Text = "仮"
    .TextFrame2.TextRange.Characters(1, 1).Font.Size = 11
    .TextFrame2.VerticalAnchor = msoAnchorMiddle
    .TextFrame2.HorizontalAnchor = msoAnchorCenter
    .Fill.Visible = msoFalse
    .Line.Visible = msoFalse
    .Fill.ForeColor.RGB = vbWhite
    .Line.Visible = msoFalse
  End With
  Set 碁盤座標共通 = sp
End Function

Sub 碁石作成(argRng)
  Dim i, j
  For i = 1 To g路盤数
    For j = 1 To g路盤数
      透明碁石作成 argRng, i, j
    Next
  Next
End Sub

Sub 透明碁石作成(argRng, i, j)
  Dim sp
  Set sp = argRng.Worksheet.Shapes.AddShape(msoShapeOval, 0, 0, PixcelToPoint(g碁盤幅) - 2, PixcelToPoint(g碁盤幅) - 2)
  
  sp.Fill.Transparency = 1
  sp.Fill.ForeColor.RGB = vbWhite
  sp.Line.Visible = msoFalse
  
  sp.Top = argRng.Offset(i, j).Top - argRng.Offset(i, j).RowHeight / 2 + 1
  sp.Left = argRng.Offset(i, j).Left - argRng.Offset(i, j).Width / 2 + 1
  
  sp.OnAction = "打つ"
  sp.Name = "碁石" & 文字列Index(i, j)
End Sub

Sub 星作成(argRng)
  '天元
  星作成個別 CInt((g路盤数 - 0.5) / 2) + 1, CInt((g路盤数 - 0.5) / 2) + 1
  
  If g路盤数 >= 13 Then
    星作成個別 4, 4
    星作成個別 g路盤数 - 3, 4
    星作成個別 4, g路盤数 - 3
    星作成個別 g路盤数 - 3, g路盤数 - 3
  End If
  
  If g路盤数 = 19 Then
    星作成個別 4, CInt((g路盤数 - 0.5) / 2) + 1
    星作成個別 CInt((g路盤数 - 0.5) / 2) + 1, 4
    星作成個別 g路盤数 - 3, CInt((g路盤数 - 0.5) / 2) + 1
    星作成個別 CInt((g路盤数 - 0.5) / 2) + 1, g路盤数 - 3
  End If
End Sub
Sub 星作成個別(i, j)
  Dim sp, wd
  wd = 0
  Set sp = gWS.Shapes.AddShape(msoShapeOval, 0, 0, PixcelToPoint(10), PixcelToPoint(10))
  With sp
    .ZOrder msoSendToBack
    .Fill.Transparency = 0
    .Fill.ForeColor.RGB = vbBlack
    .Line.Visible = msoFalse
    .Top = gWS.Range(c開始位置).Offset(i, j).Top - 3
    .Left = gWS.Range(c開始位置).Offset(i, j).Left - 3
    .Name = "星" & i & j
  End With
End Sub

Sub ClearShapes(ws)
  Dim sp
  For Each sp In ws.Shapes
    If sp.Name Like "碁石*" Or _
      sp.Name Like "座標*" Or _
      sp.Name Like "星*" Or _
      sp.Name Like "手数*" Then
      sp.Delete
    End If
  Next
End Sub

上記VBAで使っている、
ColumnWidthPixcel
RowHeightPixcel
これらは、前作と同様です。
Excel囲碁:万波奈穂先生に捧ぐ
Excelで囲碁を作ってみます。AI搭載とかそんな大層なものではありません。人vs人で対戦できる程度、単純に黒白交互に打っていけるものです。ただし、・相手の石を囲んだら相手の石を取るのは自動にします。・着手禁止点には着手できないようにします。

以下の解説ページで紹介しているVBAを使っています。
適当な数値で合わせてしまえば良いのですが、路盤数を自由に設定できるようにしたので、列幅行高もきっちり合うようにしたものです。

列幅・行高をDPI取得しピクセルで指定する
VBAでは、ワークシートの列幅は文字数、行高はポイントで設定します。これらでの指定は便利な時もありますが、VBAで設定する場合に不便になる事も多くあります。そもそも、列幅と行高が別々の単位になっているので設定しづらいのです。

Excel囲碁のダウンロード

zipとxlsmを用意しました。


他のゲーム(数独、オセロ、将棋)も含めたダウンロード一覧は以下になります。



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

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


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

import文(パッケージ・モジュールのインポート)|Python入門(9月24日)
例外処理(try文)とexception一覧|Python入門(9月23日)
リスト内包表記|Python入門(9月22日)
Pythonの引数は参照渡しだが・・・|Python入門(9月21日)
lambda(ラムダ式、無名関数)と三項演算子|Python入門(9月20日)
関数内関数(関数のネスト)とスコープ|Python入門(9月18日)
関数の定義(def文)と引数|Python入門(9月18日)
組み込み関数一覧|Python入門(9月17日)
辞書(dict型)|Python入門(9月16日)
入力規則への貼り付けを禁止する|VBA技術解説(9月16日)


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

1.最終行の取得(End,Rows.Count)|VBA入門
2.RangeとCellsの使い方|VBA入門
3.変数宣言のDimとデータ型|VBA入門
4.マクロって何?VBAって何?|VBA入門
5.セルのコピー&値の貼り付け(PasteSpecial)|VBA入門
6.Range以外の指定方法(Cells,Rows,Columns)|VBA入門
7.繰り返し処理(For Next)|VBA入門
8.セルに文字を入れるとは(Range,Value)|VBA入門
9.とにかく書いてみよう(Sub,End Sub)|VBA入門
10.マクロはどこに書くの(VBEの起動)|VBA入門




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


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



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