[[20140211175927]]　『エクセルでゲームを作りたいのです。』（初心者）　ページの最後に飛ぶ

『エクセルでゲームを作りたいのです。』（初心者）

      D  E F G H I J

　　　
4　　　　　●●●
5　　　　　●●●
6　　●●●●●●●
7　　●●●　 ●●●
8　　●●●●●●●
9　　　　　●●●
10 　　　●●●

　エクセルでゲームを作りたいのですが
Ｇ5をＧ７にドラッグすると、Ｇ5、Ｇ6が空白でＧ7が黒
Ｅ6をＧ6にドラッグすると、Ｅ6、Ｆ6が空白でＧ6が白になるようにし、順次　　　　　黒を1つ跨いで空白に行き最後にＧ7のみ残るようなゲームをエクセルでつくり　　　　　たいのですが、どなたかご教授願います。
※縦横しか移動できません
※同じマスが何回も黒になります

＜使用 Excel：Excel2007、使用 OS：Windows7 ＞

 興味本位のたたき台まで。
 シートモジュールに置き、G7 をダブルクリックでスタート。

 Const C_OFF = 2
 Const C_ON = 16

 Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Target.Address = "$G$7" Then
        If MsgBox("ゲームをリセットしますか？", vbYesNo) = vbNo Then Exit Sub
        Cells.Clear
        Columns("D:J").ColumnWidth = 2
        Range("F4:H10").Interior.ColorIndex = C_ON
        Range("F4:H10").Borders.Weight = xlThin
        Range("D6:J8").Interior.ColorIndex = C_ON
        Range("D6:J8").Borders.Weight = xlThin
        Range("G7").Interior.ColorIndex = C_OFF
    End If
 End Sub

 Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Columns.Count = 1 And Target.Rows.Count = 1 Then
        Exit Sub
    End If
    If Target.Columns.Count > 1 And Target.Rows.Count > 1 Then
        ActiveCell.Select
        Exit Sub
    End If

    Dim dstCell As Range
    If ActiveCell.Interior.ColorIndex = C_OFF Then
        ActiveCell.Select
        Exit Sub
    End If

    If Target.Columns.Count > 1 Then
        If Target.Cells(1, 1).Column = ActiveCell.Column Then
            Set dstCell = Target.Cells(1, Target.Cells.Columns.Count)
        Else
            Set dstCell = Target.Cells(1, 1)
        End If
    Else
        If Target.Cells(1, 1).Row = ActiveCell.Row Then
            Set dstCell = Target.Cells(Target.Rows.Count, 1)
        Else
            Set dstCell = Target.Cells(1, 1)
        End If
    End If

    If dstCell.Interior.ColorIndex = C_ON Then
        ActiveCell.Select
        Exit Sub
    End If

    If Intersect(dstCell, Range("F4:H10,D6:J8")) Is Nothing Then
        ActiveCell.Select
        Exit Sub
    End If

    Dim r As Range
    Dim cnt As Long
    For Each r In Target
        If r.AddressLocal <> dstCell.AddressLocal Then
            cnt = cnt + 1
            If r.Interior.ColorIndex = C_OFF Or cnt = 3 Then
                ActiveCell.Select
                Exit Sub
            End If
        End If
    Next

    If cnt <= 1 Then
        ActiveCell.Select
        Exit Sub
    End If

    For Each r In Target
        If r.AddressLocal <> dstCell.AddressLocal Then
            r.Interior.ColorIndex = C_OFF
        Else
            r.Interior.ColorIndex = C_ON
        End If
    Next

    If checkCount() = 1 Then MsgBox "You Win!!"
 End Sub

 Private Function checkCount()
    For Each r In Range("D4:J10")
        If r.Interior.ColorIndex = C_ON Then checkCount = checkCount + 1
    Next
 End Function

（Mook） 2014/02/11(火) 19:23

Mookさん有難うございました。●ではできないでしょうか？
（初心者） 2014/02/11(火) 21:42

 出来ると思いますが、
 > 興味本位のたたき台まで。
 なので、細かい修正はご自身でお願いします。

 匿名でないハンドルを利用いただいていれば、もう少し対応の意欲も変わったかもしれま
 せんが・・・。
（Mook） 2014/02/11(火) 23:00

 試していませんが、多分
 .Interior.ColorIndex  を　 .Value　 に
 先頭の宣言を
  Const C_OFF = ""
  Const C_ON = "●"
 に変えたらできないかな？
（Mook） 2014/02/11(火) 23:09

コメント返信：

[ 一覧(最新更新順) ]

[[20140211175927]] 『エクセルでゲームを作りたいのです。』（初心者） ページの最後に飛ぶ

[[20140211175927]]　『エクセルでゲームを作りたいのです。』（初心者）　ページの最後に飛ぶ