セルをドットみたいに動かして遊んでみた【Excel VBA】

2015年8月27日2017年5月18日

最近Excelを使うことが多くて、データを分類したり加工したりするマクロを作ったり、久しぶりにVisual Basicでプログラムを書きました。でもずっと方眼紙のようなマス目を見ていると、ファミコンのような昔のゲームを思い出します。

というわけで、今回はエクセルのセルを使って壁に跳ね返るボールのような動きを作ってみました。

動作環境
レイアウト
マクロの作成
マクロをボタンに割り当て
実行してみましょう
おわりに

動作環境

Microsoft Office 365 Soloを使用しています。
WindowsでもMacでも動きますが、Mac版の方はなぜかマクロが実行できないことがありましたのでWindows版の方が安定しているようです。

レイアウト

使うシートは1つだけです。名前は自動で付いている「Sheet1」のままで変更しなくて大丈夫です。

A1のセルからAF22のあたりまで、セルの色を黒く塗って壁を作ります。あとはマクロの実行用に図形を一つ作っておいてください。

マクロの作成

レイアウトの作成が終わったら、マクロを作成します。メニューの「ツール」-「マクロ」-「Visual Basic Editor」でマクロ編集画面を開いて、モジュールを作成します。

※作成方法がわからない場合は、「ツール」-「マクロ」-「新しいマクロを記録」を選んですぐに「ツール」-「マクロ」-「記録終了」を選ぶとサクっと作れます。

簡単に説明しますと、まずcheckCollisionという関数で、ボールが動く先に障害物があるかチェックしています。もし壁やカーソルがあれば移動する方向を反転するようにしています。

Sub dotmove()
    Dim x As Integer
    Dim y As Integer
    Dim nextX As Integer
    Dim nextY As Integer
    Dim moveX As Integer
    Dim moveY As Integer

    'スピード調整用の変数
    Const counter = 2

    '初期座標
    x = 2
    y = 2

    '初期移動方向
    moveX = 1
    moveY = 1

    Do While True
       ' 左右の障害物チェック
        If checkCollision(x + moveX, y) = True Then
            moveX = moveX * -1
        End If
        '上下の障害物チェック
        If checkCollision(x, y + moveY) = True Then
            moveY = moveY * -1
        End If
        '斜め前の障害物チェック
        If checkCollision(x + moveX, y + moveY) = True Then
            moveX = moveX * -1
            moveY = moveY * -1
        End If

        ' 次の表示位置を決定
        nextX = x + moveX
        nextY = y + moveY

        '障害物がなければ描画する
        If checkCollision(nextX, nextY) = False Then
            Worksheets("sheet1").Cells(nextX, nextY).Interior.Color = RGB(0, 0, 255)
            If nextX = x And nextY = y Then
            Else
                Worksheets("sheet1").Cells(x, y).Interior.Color = RGB(255, 255, 255)
            End If
            x = nextX
            y = nextY
        End If

        For I = 0 To counter
            DoEvents
        Next I
    Loop


End Sub

Function checkCollision(x As Integer, y As Integer) As Boolean
    checkCollision = False

    If Worksheets("sheet1").Cells(x, y).Interior.Color <> RGB(0, 0, 0) And Application.Intersect(Range(Worksheets("sheet1").Cells(x, y), Worksheets("sheet1").Cells(x, y)), ActiveCell) Is Nothing Then
    Else
        checkCollision = True
    End If

End Function

Sub dotmove()

Dim x As Integer

Dim y As Integer

Dim nextX As Integer

Dim nextY As Integer

Dim moveX As Integer

Dim moveY As Integer

'スピード調整用の変数

Const counter = 2

'初期座標

x = 2

y = 2

'初期移動方向

moveX = 1

moveY = 1

Do While True

' 左右の障害物チェック

If checkCollision(x + moveX, y) = True Then

moveX = moveX * -1

End If

'上下の障害物チェック

If checkCollision(x, y + moveY) = True Then

moveY = moveY * -1

End If

'斜め前の障害物チェック

If checkCollision(x + moveX, y + moveY) = True Then

moveX = moveX * -1

moveY = moveY * -1

End If

' 次の表示位置を決定

nextX = x + moveX

nextY = y + moveY

'障害物がなければ描画する

If checkCollision(nextX, nextY) = False Then

Worksheets("sheet1").Cells(nextX, nextY).Interior.Color = RGB(0, 0, 255)

If nextX = x And nextY = y Then

Else

Worksheets("sheet1").Cells(x, y).Interior.Color = RGB(255, 255, 255)

End If

x = nextX

y = nextY

End If

For I = 0 To counter

DoEvents

Next I

Loop

End Sub

Function checkCollision(x As Integer, y As Integer) As Boolean

checkCollision = False

If Worksheets("sheet1").Cells(x, y).Interior.Color <> RGB(0, 0, 0) And Application.Intersect(Range(Worksheets("sheet1").Cells(x, y), Worksheets("sheet1").Cells(x, y)), ActiveCell) Is Nothing Then

Else

checkCollision = True

End If

End Function

マクロをボタンに割り当て

ここまでできたら、最初に作成した図形にマクロを登録して完了です。図形をcontrolキーを押しながらクリック、または右クリックでメニューを開き、「マクロの登録」を選択して「dotmove」を設定します。

実行してみましょう

では図形をクリックして実行してみましょう。青いドットが動き回ります。機種やOSによって実行スピードが違うので、速すぎる場合はcounterの値を大きめにして調整してみてください。

壁やカーソルに当たるとはね返ります。黒でセルを塗りつぶしたり、十字キーでカーソルを追いかけてみたりできます。

おわりに

全く何かに役だつことはないですが、重要な情報が入ったセルに色を付けるマクロを作ってるうちに試してみたくなって、軽い気持ちで作ってみました。移動エリアを広くして障害物になる壁をたくさん配置して、一番移動量の少ない人が勝ち！みたいな遊び方ができるんじゃないかなと思います。

プログラムなんてそんなに難しく考えないで、楽しんで適当に作ってみるのも面白いですよ。

Excel 最強の教科書完全版――すぐに使えて、一生役立つ「成果を生み出す」超エクセル仕事術

Excel VBA