エクセルマクロで野生のマグロを駆逐するミニゲームを作ってみた

野良マグロを養殖して駆逐するミニゲームを作ってみたので紹介する。

前置き

まずは下記の記事をご覧いただきたい。

週刊アスキー　アニメイトグループ社内の“天然マクロ”を駆逐したkintone

「天然マクロ」と呼ばれる社内スタッフ独自のマクロだけでなく、システム部で作った「養殖マクロ」もあるが、養殖マクロが現場で運用・改修されるうちに「野生化」して手が付けられなくなるトラブルもあった。

私はこの文章で腹筋が崩壊した。

マグロ🐟じゃないよ！マクロだよ！

はい、ご所望のマクロを駆逐するゲームでございます。

https://youtu.be/XY2RtD_GLjoyoutu.be

いやいや、これマクロじゃないよ！マグロ🍣だよ！！！

ソースコード

'タイトル : マグロの駆逐ゲーム
'開発元   : ことりちゅん
'公開場所 : https://paper.dropbox.com/doc/--AknLXdI6ZTBi4b_Ltoy7JSB8Ag-SQCwhikch0e3rIH0tNILC
'作成日   : 2019/09/11
'
'更新履歴 : 2019/09/11 21:30 公開
'           2019/09/11 22:30 更新 解説コメント追記
'           2019/09/12 22:30 更新 Shape.Copy/PasteをDuplicateへ変更
'           2019/09/24 20:30 更新 マグロの駆逐バージョンに改造
'
'設置方法
' 1.Sheet1を使用すること。
' 2.標準モジュールにコード全体をコピペ
' 3.家を配置して名前をHome、マクロを設定
' 4.Gを配置して名前をG、マクロを設定
' 5.リセットボタンを配置して名前をVARSAN、マクロを設定
' 6.Gを「背景の削除」機能で白い部分を透過すると良い
'
Option Explicit

'--------------------------------------------------
'----------モジュール変数----------
Private isGameing As Boolean
Private isGiveUp As Boolean
Private StartTime As Date
Private cntG As Long

'--------------------------------------------------
'----------定数----------
Const PROJECT_NAME_G = "野生のマグロ"  'プロジェクト名、ベースシェイプ名
Const GAMEOVER_NAME = "NETA"
Const BACKGROUND_NAME = "Home"

'----------ゲームパラメータ----------
Const 開始時増殖数 = 5
Const 開始時サイズ = 10
Const 成長率 = 1.1
Const 討伐時増殖率 = 1.5
Const 成長時増殖率 = 1.1
Const 出産開始サイズ = 40
Const 最大サイズ = 50
Const ゲーム続行最大値 = 100

'--------------------------------------------------
'----------プロパティ----------

'発生領域
Property Get MAXX() As Long
    MAXX = Sheet1.Shapes(BACKGROUND_NAME).Width
End Property

Property Get MAXY() As Long
    MAXY = Sheet1.Shapes(BACKGROUND_NAME).Height
End Property

'コピー元のG
Property Get BaseG() As Shape
    Set BaseG = Sheet1.Shapes(PROJECT_NAME_G)
End Property

'コピー元のネタ
Property Get BaseNeta() As Shape
    Set BaseNeta = Sheet1.Shapes(GAMEOVER_NAME)
End Property

'増殖後のG
Property Get Gs() As Collection
    Set Gs = New Collection
    Dim SHP As Shape
    For Each SHP In Sheet1.Shapes
        If SHP.Name Like PROJECT_NAME_G & "#*" Then
            Gs.Add SHP
        End If
    Next
End Property

'増殖後のG
Property Get Netas() As Collection
    Set Netas = New Collection
    Dim SHP As Shape
    For Each SHP In Sheet1.Shapes
        If SHP.Name Like GAMEOVER_NAME & "*#" Then
            Netas.Add SHP
        End If
    Next
End Property

'バルサン
Property Get VARSAN() As Shape
    Set VARSAN = Sheet1.Shapes("VARSAN")
End Property

'--------------------------------------------------
'----------イベントハンドラ----------

'家に帰宅する
Sub Home_Click()
    If Not isGameing Then
        Randomize
        isGameing = True
        isGiveUp = False
        cntG = 0
        VARSAN.Visible = msoFalse
        Dim SHP As Shape
        For Each SHP In Netas
            SHP.Delete
        Next
        StartTime = Time()
        
        Call CreateG(開始時増殖数)
        
        Call GameLoop
    End If
End Sub

'Gの駆除
Sub G_Click()
    If Application.Caller = PROJECT_NAME_G Then Exit Sub
    Randomize
    
    'サイズに関係なく、一定確率で増殖
    Call CreateG(Rnd() * 討伐時増殖率)
    
    Sheet1.Shapes(Application.Caller).Delete
End Sub

'バルサン使用
Sub VARSAN_Click()
'    Call FadeOut
    Call GiveUp
End Sub

'--------------------------------------------------
'----------サブルーチン----------

'Gの生成
Sub CreateG(num As Long)
    Dim i As Long
    For i = 1 To num
        cntG = cntG + 1
        With BaseG.Duplicate
            .Name = PROJECT_NAME_G & cntG
            .Width = 開始時サイズ
            .Height = 開始時サイズ
            .Left = Rnd() * (MAXX - 10)
            .Top = Rnd() * (MAXY - 10)
        End With
    Next
End Sub

'時間が進む
Sub GameLoop()
    If isGiveUp Then Exit Sub
    
    Call LevelUP_G
    
    Select Case Gs.Count
        Case 0
            MsgBox "世界から" & PROJECT_NAME_G & "を完全に駆逐しました！" & vbLf & _
                    "今後は掃除を欠かさずやりましょう！！！" & vbLf & vbLf & _
                    "　討伐数：" & cntG & vbLf & _
                    "所要時間：" & Format(Time() - StartTime, "hh:mm:ss"), _
                        vbInformation + vbOKOnly, PROJECT_NAME_G & "駆逐"
            isGameing = False
            
        Case Is <= ゲーム続行最大値
            If Not isGiveUp Then Application.OnTime [Now() + "00:00:01"], "GameLoop"
            
        Case Else
            MsgBox "世界に" & PROJECT_NAME_G & "が溢れかえってしまった！！！" & vbLf & _
                    "", _
                        vbCritical + vbOKOnly, PROJECT_NAME_G & "駆逐"
            VARSAN.Visible = msoTrue
            VARSAN.ZOrder msoBringToFront
    End Select
End Sub

'Gの成長
Sub LevelUP_G()
    Dim SHP As Shape
    For Each SHP In Gs
        If SHP.Width < 最大サイズ Then
            SHP.Left = SHP.Left - (SHP.Width * 成長率 - SHP.Width) / 2
            SHP.Top = SHP.Top - (SHP.Height * 成長率 - SHP.Height) / 2
            SHP.Width = SHP.Width * 成長率
            SHP.Height = SHP.Height * 成長率
        End If
        Call CreateG(SHP.Width > 出産開始サイズ And (Rnd() * 成長時増殖率))
    Next
End Sub

'フェードアウト
Sub FadeOut()

'    Dim i As Long
'    For i = 1 To 5
'        Dim SHP As Shape
'        For Each SHP In Gs
''            SHP.Fill.Transparency = 1
''            SHP.Shadow.Transparency = 1
''            SHP.Fill.Visible = msoFalse
''            SHP.Shadow.Transparency = SHP.Shadow.Transparency - 0.1
''            SHP.Shadow.Visible = True
''            SHP.Shadow.Obscured = msoCTrue
'        Next
'        Application.Wait [Now() + "00:00:00.2"]
'        Application.ScreenUpdating = True
'    Next
'
End Sub

'ギブアップ
Sub GiveUp()
    isGiveUp = True
    isGameing = False
    
    VARSAN.Visible = msoFalse
    
    Dim SHP As Shape
    For Each SHP In Gs
        With BaseNeta.Duplicate
            .Visible = msoTrue
            .Name = GAMEOVER_NAME & cntG
            .Width = SHP.Width
            .Height = SHP.Height
            .Left = SHP.Left
            .Top = SHP.Top
        End With
        SHP.Delete
        
        Application.Wait [Now() + "00:00:00.1"]
        DoEvents
    Next
    
    MsgBox "世界は平和になりましたとさ", vbOKOnly + vbInformation, PROJECT_NAME_G
    
End Sub

Sub Reset()
    isGiveUp = True
    isGameing = False

    Dim SHP As Shape
    For Each SHP In Gs
        SHP.Delete
    Next
    
    For Each SHP In Netas
        If SHP.Name <> GAMEOVER_NAME Then
            SHP.Delete
        End If
    Next
    
    With VARSAN
        .ScaleHeight 1, msoScaleFromMiddle
        .Visible = msoFalse
    End With
    
End Sub

導入方法

1.Alt+F11を押して、標準モジュールを挿入し、上記ソースコードを貼り付けます。

2.挿入→オンライン画像　から、図を追加していきます。

• 海

• マグロ

• 板前

3.図を選択して、背景の削除から背景部分を抜き取ります。

4.図を選択して左上の名前ボックスで名前を変えていきます。

• 海の名前をHomeに。

• マグロの名前を野生のマグロに。

• マグロの寿司の名前をNETAに。

• 板前の名前をVARSANに。（過去に制作したマクロの弊害）

5.図にマクロを埋め込んでいきます。

• 海にHome_Clickを。

• マグロにG_Clickを。

• ネタにNETA_Clickを。

• 板前にVARSAN_Clickを。

解説

今回はマクロの解説は割愛します。

補足

実はこれ、先日あそびで作った黒光りするヤツを駆逐するゲームに手を加えただけです。

ふと思いついたので作ってみた。（1時間） pic.twitter.com/VETjyjpoOx

— ことりちゅん@えくせるちゅんちゅん (@KotorinChunChun) 2019年9月11日

本件のツイート

https://t.co/HinGmDWXkc

＞「天然マクロ」と呼ばれる社内スタッフ独自のマクロだけでなく、システム部で作った「養殖マクロ」もあるが、養殖マクロが現場で運用・改修されるうちに「野生化」して手が付けられなくなるトラブルもあった。

ここで爆笑してしまった。

— ことりちゅん@えくせるちゅんちゅん (@KotorinChunChun) 2019年9月24日

まとめ

面白いネタを提供してくれた元記事の筆者には最大の感謝を。

黒いヤツを駆逐するゲーム開発時の変数名や関数名が具体的すぎて、移植中にもっと抽象化しておけば良かったと反省した。

（いつになるか分からないけど）次に作るゲームではこの辺りにも気を配りたい。

以上

---

何か御座いましたらコメント欄、またはTwitterからどうぞ♪

それではまた来週♪　ちゅんちゅん(・8・)