数式や関数を打ち間違えるとニコニコ動画風に煽ってくるExcel VBAマクロの作り方

f:id:tdyu5021:20200525220235p:plain

先日Twitterに「Excel操作中に関数や数式を打ち間違えたときニコニコ動画風に煽ってくるクッソうざいマクロ」というネタVBAを投稿したところ、想像以上にバズりまくってビビってます。汎用的に使えるものではないですし公開する気はさらさらなかったのですが、実態は初学者でもわかる簡易なプログラムですし、ネタが一人歩きしたことで私がすごい技術を使っていると誤解されたくもないので、中身を公開することにしました。ソースコードは最後にまとめて載せます。

話題のクッソウザいマクロがこちら

まずは以下のツイートをご覧ください。

Excel操作中に関数や数式を打ち間違えたときニコニコ動画風に煽ってくるクッソうざいマクロを開発しました。#Excel #VBA #マクロ pic.twitter.com/V4l1BPUCr8
— (有) (@tdyu05) 2020年5月22日

見ての通り、関数の名前を打ち間違えたことでエラーを起こしてしまうと大量の煽りコメントで罵倒されるという精神的にやられるプログラムです。

まさかこんなにバズると思わなかった…というくらいバズってしまい、前回の集中線VBAと同様Togetterにまとめられただけでなく、まとめサイト（俺的ゲーム速報）にもまとめられてしまうという事態に…

togetter.com

jin115.com

（※2020年5月27日追記：ねとらぼにも取り上げられました。これは結構嬉しかった）

nlab.itmedia.co.jp

そんなこんなでいろいろ引用RTやらリプやらでコメントをいただく中で、

「こんな知識と技術の無駄遣い、最高にステキです」

だとか

「UZEEEEEEEE(褒め言葉)」

とか言ってくださるコメントもあり、それはそれで嬉しいのですが、私は特にVBAに詳しいわけでもないですし、別に実態としては大したことはしてないです。

というわけで、その中身を1つずつ紹介していきます。

関数の打ち間違いを検出する

まず入力間違いの判定です。ここは何も難しいことをしていなく、ただIsError関数を使って「数式や関数がエラーになればプロシージャを呼び出す」ということをしているだけです。シートモジュールに以下のコードを記述しています。

Private Sub Worksheet_Change(ByVal Target As Range)
    If IsError(Target.Value) Then
        Call 今回のマクロ
    End If
End Sub

テキストボックスを生成する

多分、Excel VBAをまともに使っている人の大半はセルを操作したりするので、オートシェイプやテキストボックスを扱うことはあまりないんじゃないかなと思います。ここはとっつきにくい部分ですが、テキストボックスをアクティブなシートに生成するには以下のように、ShapeオブジェクトのAddTextboxメソッドを使用します。

（説明のために実際のコードから少々簡略化して記載しています）

Sub test()
    Dim tbx As Shape
    Set tbx = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1000, 10, 100, 30)
End Sub

1つの目の引数はテキストボックス上の文字の方向です。以降の引数は

第2引数：テキストボックスの左端位置
第3引数：テキストボックス上端位置
第4引数：テキストボックスの幅
第5引数：テキストボックスの高さ

です。つまり上記を実行すると、画面左から1000、上から10の位置に、幅100高さ30のテキストボックスが生成されます。

ちなみに、コメントは画面右からスタートして左に流れますが、残念ながら開始位置を厳密に制御するのはVBAでは難しいです。そのユーザーがExcelの画面のどの列まで表示させているかどうかは、画面の表示倍率やPCのディスプレイのサイズによって異なるからです。

というわけでこのプログラムでは、適当に「アクティブセルのLeftプロパティの数値からプラス400くらいしたところ」と決め打ちしています。この数字には特に意味はありません。

なので関数の打ち間違いを起こしたセルがA列とかだったらコメントは中央辺りから流れてしまいます。

テキストボックスのスタイルを整える

テキストボックスを生成しましたが、このままだと塗りつぶしや線などがデフォルトの状態に設定されているのでそれらを調整します。今回適用したテキストボックスのスタイルは以下です。

Sub test()
Dim tbx As Shape
    Set tbx = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 10, 10, 1000, 30)
    With tbx
            .Fill.Visible = msoFalse    '//塗りつぶしの有無
            .Line.Visible = msoFalse    '//線の有無
            .TextFrame2.MarginTop = 0       '//テキストボックスの上の余白
            .TextFrame2.MarginRight = 1.8   '//テキストボックスの右の余白
            .TextFrame2.MarginBottom = 0   '//テキストボックスの下の余白
            .TextFrame2.MarginLeft = 2   '//テキストボックスの左の余白
            .TextFrame2.VerticalAnchor = msoAnchorMiddle    '//垂直方向の配置（ここでは上下中央）
            .TextFrame2.HorizontalAnchor = msoAnchorNone    '//水平方向の配置（ここでは設定無し）
            .TextFrame2.TextRange.Font.Size = 18     '//フォントサイズ
            .TextFrame2.TextRange.Font.NameFarEast = "ＭＳ Ｐゴシック"   '//フォントの種類
            .TextFrame2.TextRange.Font.Bold = True    '//ボールドかどうか
    End With
End Sub

（今思うと何でテキストボックスの余白まで設定しているかは謎）

あとはテキストボックスのTextFrame2.TextRange.Characters.Text プロパティで、流すコメントのテキストを入れておきます。今回のプログラムでは、20種類の決め打ちのコメントを配列で用意しており、それをランダムに入れています。

Twitterからのコメントでは「Average関数以外でもその関数に合った間違いを指摘してくれるのか？」的なコメントがありましたが、もちろんそんな高度なプログラムではありません笑

もう一度いいますが、コメントは全部決め打ちです。

テキストボックスを左に動かす

いったん説明のために簡略化していますが、テキストボックス（tbx）を左に流すコードは以下のように記述しています。ループの回数は適当です。

For i = 1 To 500
   tbx.IncrementLeft -2
   Application.Wait [Now() + "0:00:00.01"]
Next i

IncrementLeftプロパティは、Shapeオブジェクトの左位置を指定するものです。これをループさせることでテキストボックスを左に2ごと移動させています。ただし、この記述だけだと一瞬でループの回数分移動してしまうのでアニメーションのように動きません。そこで以下の記述を追加します。

Application.Wait [Now() + "0:00:00.01"]

Waitメソッドはプログラムの処理を一瞬止めるためのメソッドです。これをループ中に仕込み、0.01秒止めることでテキストボックスの移動が連続して行われているように見せることができます。

テキストボックスが一番左に来たら、そのテキストボックスの位置を再度画面右側に移し、かつ中身のコメントも別のものに変更します。簡略化しますが、ここは以下のような処理です。

If tbx.Left < 10 Then
    tbx.Left = [画面の右側の方の位置をランダムに]
    tbx.TextFrame2.TextRange.Characters.Text = [用意したコメントからランダムに]
End If

大量のコメントを別々のスピードで流す

ここまでコードを簡略化して紹介してきましたが、このままのコードではテキストボックスは1つしか流れてきません。たくさんコメントを流すにはどうするかというと、配列変数を用いて変数tbxをForループでたくさん生成すればよいのです。

合わせて、それぞれのテキストボックスに異なる高さを設定しておけば画面のいろいろな高さから出てきます。

テキストボックスの流れる速さをそれぞれ変えるのは簡単で、先ほどご紹介したIncrementLeftプロパティの引数の数値をたくさん生成したテキストボックスごとに変えればよいのです。

これを行うには配列変数tbx()に対し、IncrementLeftの引数もspeed()のように配列変数にしてランダムな数字をいれておきます。tbx(0)にはspeed(0)で、tbx(1)にはspeed(1)で左に進むようにする、という感じです。

終わったらテキストボックスをすべて消す

ShapeオブジェクトにはTypeプロパティというものがあり、オートシェイプなのかテキストボックスなのかなど、Shapeの種類を取得できるプロパティがあります。テキストボックスはmsoTextBoxなので、テキストボックスを全て削除するプログラムは以下のように記述しています。

Sub deleteAll()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoTextBox Then
            shp.Delete
        End If
    Next shp
End Sub

終わりに

以上です。内容としてはざっとこんな感じです。

このプログラムは直接シートモジュールに、Changeイベントによる間違い検知のコードを記載していますし、何よりコメントが流れ始める位置はユーザーの表示環境によって異なり、そこを吸収できるように汎用的に作られてはいません。

あと、コメントが画面の最左端まで流れて来たとき、それより左には進めないので、そこでコメントを消さざるを得ないのも個人的には気になっています。

（おわかりかと思いますが、ニコニコ動画では、コメントが画面から見切れるまで流れ続けています）

このジョークプログラムは本当はアドイン化したかったのですが、なんか方法があるんですかね、これ。

シートモジュールのイベントプロシージャはクラスモジュールに書けるようですが、アドイン化できるかはいまのところ私の知識ではわかりません。

というわけで、いろいろ中途半端ですが、以下にコードを載せておきます。まぁ絶対に誰も使うことはないと私は確信していますが、ご使用の場合はすべて自己責任でお願いします…笑

'****************************************
'*シートモジュール
'****************************************
Private Sub Worksheet_Change(ByVal Target As Range)
    If IsError(Target.Value) Then
        Call test
    End If
End Sub
'****************************************
'*標準モジュール
'****************************************
Dim tbx(8) As Shape
Dim speed(8) As Integer
Sub test()
    Randomize
    
    '//コメントを全部配列に（数はいくつでもOK）
    arr = Array _
    ( _
    "だせえwwwwwwwwww", _
    "これ完全Excel初心者だろ", _
    "これは無能", _
    "こんなの同じ会社にいたら嫌だわ", _
    "wwwwwwwwwwwwwww", _
    "普通そんな間違いしないだろwww", _
    "これはありえない", _
    "ダサすぎてワロタ", _
    "俺でもさすがにAverageは打てるぞ", _
    "関数も使えないとか草", _
    "Average関数もわからないとかwwwwwwww", _
    "こいつは間違いなく無能", _
    "Average関数で間違えるやつ初めて見た", _
    "これがゆとり教育の弊害か・・・", _
    "ワロタ", _
    "えっそこ間違える！？", _
    "Excelよりも英語の勉強をやり直したほうが", _
    "そもそもこの表は何なんだよ", _
    "wwwwwwwwwwwwwwwwwwwww", _
    "wwwwwwwwwwwwwwwwwwwwwww" _
     )

    '//コメントの配列の長さを取得
    arrLen = UBound(arr)
    
    '//数字を適当に並べる
    hArr = Array(2, 5, 4, 1, 3, 7, 6, 8, 9)
    
    '//アクティブセルの左位置と高さを取得
    cpl = ActiveCell.Left
    cph = ActiveCell.Height
    
    For i = 0 To 8
        n = hArr(i) * 30
        '//テキストボックスを生成
        Set tbx(i) = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, cpl + 400, n, 400, 30)
        
        '//テキストボックスのスタイルをもろもろ設定
        With tbx(i)
            .Fill.Visible = msoFalse
            .Line.Visible = msoFalse
            .TextFrame2.MarginTop = 0
            .TextFrame2.MarginRight = 1.8
            .TextFrame2.MarginBottom = 0
            .TextFrame2.MarginLeft = 2
            .TextFrame2.VerticalAnchor = msoAnchorMiddle
            .TextFrame2.HorizontalAnchor = msoAnchorNone
            .TextFrame2.TextRange.Font.Size = 18
            .TextFrame2.TextRange.Font.NameFarEast = "ＭＳ Ｐゴシック"
            .TextFrame2.TextRange.Font.Bold = True
        End With
        '//コメントが進むスピード（距離）
        speed(i) = Int(Rnd * 4) + 3
        
        '//配列からテキストをランダムに選んでテキストボックスに入れる
        txt = arr(Int(Rnd * arrLen))
        tbx(i).TextFrame2.TextRange.Characters.Text = txt
    Next i
    
    For ii = 1 To 600
        For j = 0 To 8
            '//テキストボックスを左に移動
            tbx(j).IncrementLeft -speed(j)
            
    '//テキストボックスが左の方まで来たらもう一度右の方に戻してコメントも入れ直す
    If tbx(j).Left < 10 Then
        tbx(j).Left = cpl + Int(Rnd * 300) + 200
        tbx(j).TextFrame2.TextRange.Characters.Text = arr(Int(Rnd * arrLen))
    End If
        Next j
        Application.Wait [Now() + "0:00:00.01"]
    Next ii
    
    '//終わったらテキストボックスを全部消す
    Call deleteAll 
End Sub
Sub deleteAll()
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoTextBox Then
            shp.Delete
        End If
    Next shp
End Sub