えくせるちゅんちゅん

ことりがエクセルをちゅんちゅんするブログ

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

下記の記事に触発されて、野生のマグロを養殖して駆逐するミニゲームを作ってみた。

f:id:Kotori-ChunChun:20190924204324p:plain


前置き

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

https://weekly.ascii.jp/elem/000/000/434/434408/

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

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


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


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

youtu.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.挿入→オンライン画像 から、図を追加していきます。

  • f:id:Kotori-ChunChun:20190924205830p:plain

  • マグロ f:id:Kotori-ChunChun:20190924205924p:plain

f:id:Kotori-ChunChun:20190924210308p:plain

  • 板前 f:id:Kotori-ChunChun:20190924205944p:plain

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

f:id:Kotori-ChunChun:20190925131158p:plain

f:id:Kotori-ChunChun:20190925131234p:plain


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

f:id:Kotori-ChunChun:20190924210037p:plain

  • 海の名前をHomeに。

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

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

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


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

  • 海にHome_Clickを。

  • マグロにG_Clickを。

  • ネタにNETA_Clickを。

  • 板前にVARSAN_Clickを。


解説

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


補足

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

本件のツイート

まとめ

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

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

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

以上


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

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

プライバシーポリシー