【VBAジョークツール①】あれ！？壊れた！？Excel起動時の無駄な演出ツールの作成方法

今回は、Excelファイルを開いた瞬間に、画面がバグったように見せかけるバグエフェクトを実装したVBAコードを解説します。悪用は厳禁です(笑)

まずは、実際にどのような演出が実行されるのか、以下の動画をご覧ください。

一見すると複雑な処理を行っているように見えますが、プログラムを要素ごとに分解すると、初学者でも理解できる明確な論理で構成されています。実務でも応用可能な「安全なエラー処理」や「UIの制御」が含まれているため、順を追って解説します。

実際のコード

ファイルを起動した際に自動実行させるため、標準モジュールとThisWorkbook モジュールにそれぞれ以下のコードを記述します。

1. 標準モジュール

#If VBA7 Then
    Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare PtrSafe Function BeepAPI Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
#Else
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    Private Declare Function BeepAPI Lib "kernel32" Alias "Beep" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long
#End If

Sub RunGlitchStartupSequence()
    Dim ws As Worksheet
    Dim originalGridlines As Boolean
    Dim originalHeadings As Boolean
    
    ' エラー時や強制終了時（Ctrl+Break）のフェイルセーフ
    On Error GoTo CleanUp
    Application.EnableCancelKey = xlErrorHandler

    ' 実行前のUI状態を保存
    originalGridlines = ActiveWindow.DisplayGridlines
    originalHeadings = ActiveWindow.DisplayHeadings

    ' Startupシートの取得・作成
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets("Startup")
    On Error GoTo CleanUp ' エラーハンドリングを再設定
    
    If ws Is Nothing Then
        Set ws = ThisWorkbook.Sheets.Add(Before:=ThisWorkbook.Sheets(1))
        ws.Name = "Startup"
    End If

    ' UI要素の非表示設定
    Application.ScreenUpdating = False
    ActiveWindow.DisplayGridlines = False
    ActiveWindow.DisplayHeadings = False

    ' 基本書式設定
    ws.Cells.Interior.Color = RGB(0, 0, 0)
    ws.Cells.Font.Color = RGB(0, 255, 0)
    ws.Cells.Font.Name = "Consolas"
    ws.Cells.Font.Size = 16
    ws.Cells.Font.Bold = True
    
    ws.Range("A1").WrapText = True
    ws.Range("A1").ColumnWidth = 150
    ws.Range("A1").RowHeight = 400
    ws.Range("A1").VerticalAlignment = xlVAlignTop

    Application.ScreenUpdating = True

    Dim mundaneLog As String
    mundaneLog = "CRITICAL SYSTEM FAILURE... JUST KIDDING." & vbCrLf & _
                 "EXCEL IS A SPREADSHEET SOFTWARE CREATED BY MICROSOFT." & vbCrLf & _
                 "ONE PLUS ONE EQUALS TWO. WATER IS WET." & vbCrLf & _
                 "YOU ARE CURRENTLY LOOKING AT A COMPUTER MONITOR." & vbCrLf & _
                 "APPLES ARE USUALLY RED OR GREEN." & vbCrLf & _
                 "SLEEPING IS VERY IMPORTANT FOR YOUR HEALTH." & vbCrLf & _
                 "THANK YOU FOR READING THIS COMPLETELY NORMAL TEXT."

    Dim currentText As String
    Dim i As Long
    Dim char As String
    
    Randomize
    ws.Range("A1").Value = ""

    ' テキスト出力とグリッチエフェクトループ
    For i = 1 To Len(mundaneLog)
        char = Mid(mundaneLog, i, 1)
        currentText = currentText & char
        ws.Range("A1").Value = currentText

        If Rnd() < 0.15 Then
            ws.Cells.Interior.Color = RGB(Int(Rnd * 255), 0, 0)
            ws.Cells.Font.Size = Int(Rnd * 30) + 10
            ws.Range("A1").ColumnWidth = Int(Rnd * 100) + 50
            BeepAPI Int(Rnd * 3000) + 500, 40
        Else
            ws.Cells.Interior.Color = RGB(0, 0, 0)
            ws.Cells.Font.Size = 16
            ws.Range("A1").ColumnWidth = 150
        End If

        DoEvents

        If char <> " " And char <> vbCr And char <> vbLf Then
            If Rnd() > 0.15 Then BeepAPI 800, 10
            Sleep 25
        Else
            Sleep 5
        End If
    Next i

    ' クラッシュ演出
    For i = 1 To 20
        ws.Cells.Interior.Color = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
        ws.Cells.Font.Color = RGB(Int(Rnd * 255), Int(Rnd * 255), Int(Rnd * 255))
        BeepAPI Int(Rnd * 2500) + 500, 30
        Sleep 30
        DoEvents
    Next i

CleanUp:
    ' 【重要】正常終了・異常終了に関わらず、必ず安全な状態へ復帰させる
    If Not ws Is Nothing Then
        ws.Cells.Interior.Color = RGB(0, 0, 0)
        ws.Cells.Font.Color = RGB(0, 255, 0)
        ws.Cells.Font.Size = 16
        ws.Range("A1").ColumnWidth = 150
        ws.Range("A1").Value = currentText & vbCrLf & vbCrLf & "[STATUS] NOTHING HAPPENED. HAVE A NICE DAY."
    End If
    
    ' 保存したUI状態とシステム設定の復元
    ActiveWindow.DisplayGridlines = originalGridlines
    ActiveWindow.DisplayHeadings = originalHeadings
    Application.ScreenUpdating = True
    Application.EnableCancelKey = xlInterrupt ' キャンセルキーの挙動を標準に戻す
End Sub

2. ThisWorkbook モジュール

Private Sub Workbook_Open()
    Call RunGlitchStartupSequence
End Sub

初心者向け：プログラムの仕組みと解説

このコードは、大きく分けて3つの技術的な要素から成り立っています。

1. 「Windows API」を利用した細かい動きと音の制御

VBAの標準機能では「1秒待機する」ことはできても「0.025秒待機する」といった細かな制御や、システム音の高さ（周波数）を指定することができません。これを解決するため、Windows OS自体の機能（API）を呼び出しています。

Sleep関数: 処理を「ミリ秒（1000分の1秒）」単位で一時停止させます。このコードでは、文字を出力するごとに25ミリ秒（空白は5ミリ秒）待機させることで、人間がキーボードを叩いているようなアニメーション効果を生み出しています。
Beep関数: 指定した周波数（Hz）と長さ（ms）で音を鳴らします。
#If VBA7 Thenの分岐: 使用しているExcelが32ビット版か64ビット版かによって、APIを呼び出すためのメモリの扱い方（ポインタ）が異なります。どちらの環境でもエラーなく動作させるための条件分岐です。

2. 環境を破壊しないための「フェイルセーフ（安全対策）」

画面を黒く塗りつぶし、通常の操作を制限するプログラムであるため、途中でエラーが起きても必ず元の状態に戻る安全装置（フェイルセーフ）が組み込まれています。

元の状態を記憶する: プログラムが動き出す前に、現在の「枠線（Gridlines）」や「見出し（Headings）」の表示状態を変数に記憶させておき、最後に必ず復元します。
Application.EnableCancelKey = xlErrorHandler: 通常、マクロの実行中に Ctrl + Break キーや Esc キーを押すと、プログラムがその場で強制終了します。しかし、この設定により、強制終了が試みられた場合でも即座には停止せず、必ず後片付けの処理（CleanUp: ラベル以降のコード）へジャンプする論理になっています。これにより、画面が真っ黒のまま操作不能になるリスクを排除しています。

3. 「乱数」を用いた確率的なバグ演出

規則正しく動くプログラムに、意図的なノイズを混ぜるために「乱数（ランダムな数値）」を活用しています。

Rnd() 関数は、0以上1未満の小数をランダムに発生させます。
コード内の If Rnd() < 0.15 Then という記述は、「生成された数値が0.15より小さい場合」を意味します。つまり、15%の確率で発生する条件分岐です。
この15%の条件を満たした瞬間にだけ、背景を赤く塗りつぶしたり、文字サイズをランダム（10〜39pt）に変更したり、不規則なビープ音を鳴らしたりすることで、機械的なバグ（グリッチ）を表現しています。

導入によるメリットとデメリット

メリット（学習効果）

VBAからWindows OSの機能を呼び出す（API）基礎が学べる。
ループ処理の中で画面の更新を許可する DoEvents の役割を視覚的に理解できる。
エラー時や強制終了時を想定した、実務にも必須の「堅牢なエラーハンドリング」の構造を実践できる。

デメリットと注意点

短い間隔で画面の描画を繰り返すため、PCのスペックによっては動作がカクつく（フレームレートが落ちる）場合があります。
スピーカーの音量が大きい環境で実行すると、高周波のビープ音が周囲の迷惑になるリスクがあるため注意してください。
共有ファイルで遊ぶ場合は関係性のある方としてください(笑)

まとめ

Excel VBAは本来、業務効率化のためのツールですが、OSの機能やランダムな数値を組み合わせることで、視覚的・聴覚的な演出を実装することも可能です。特にエラーハンドリングの設計思想は、普段の業務マクロ開発にもそのまま活かせる重要な概念です。