VBAで文字をフィーバーさせてみた

Excel VBAで意味わからんマクロ組んでみた

こんにちは、犬を飼いたい社内ニートの Castoroides です！

生きるって楽しいけど疲れませんか？
そんな時はフィーバーしましょう！

はい。
今回はそういうことで、0.5秒ずつ文字色が変わっていくマクロを作成していきます。

■ Step1 Excelの購入

そこからかい！って感じですが…
だってライセンス料高いんだもん。

そのため個人のPCには一切Officeアプリ入れてません。
だってお家はOfficeじゃないし。
もちろん業務時間でおふざけマクロ組めるほど肝座っていません。

ということでさっそくAmazonへ！

やっぱり高い！

普段会社で使い倒しているからこそ高く感じてしまう、、、
Excelは人権にかかわるのでお値段何とかなりませんか？

インストール

こんばんは～^^

無事にインストール完了しました。
（クレカの請求が怖いですが…）

■ Step2 フィーバーさせる文字の用意

この文字列を1文ずつ分割してセルに入れていきます。

数式で分割するのがおすすめです。
=MID($A1,COLUMN()-1,1)

数式をコピーするとこんな感じ

いい感じ

■ Step3 マクロ作成

ここからが本番です！

まずは、いかなる時でも迅速に本マクロを実行できるよう、
個人用マクロブックに作成したいと思います。

「表示」→「再表示」→「PERSONAL.XLSB」を選択し、
「OK」を押して個人用マクロブックを開きます。

「開発」タブから「マクロ記録」

ショートカットもしっかり設定します。
（これでいつでも フィーバーできますね！）

あとは即「マクロの記録」を終了し、具体的な処理はVBで組んでいきます。
（もっといいやり方知ってたら教えてください）

コード（最終版）は以下の通り。

'買ったからには書かなくちゃ

Const col_max As Integer = 200 '書式の上限
Dim i As Integer
Dim rng, c As Range
Dim col_list() As Variant
'キー入力取得のおまじない
Private Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long

Sub fever_string()
'
' fever_string Macro
' Let's Fever!!!!!
'
' Keyboard Shortcut: Ctrl+Shift+F
'
    MsgBox "Let's Fever!!!!!    " & vbCrLf & "(EnterキーでStop)    "

    init_color '文字色の作成
    
    Dim t_cnt As Long: t_cnt = 0
    Do While t_cnt < 1000
        Application.Wait [Now()] + 500 / 86400000
        t_cnt = t_cnt + 1
        
        change_color '文字色の変更
        
        'Enter入力で停止
        If GetAsyncKeyState(vbKeyReturn) Then
            Exit Sub
        End If
    Loop
End Sub

Sub init_color() '書式の制限回避
    Dim col_1, col_2, col_3 As Integer
    For i = 0 To col_max
        'Int(Rnd() * (最大値 - 最小値 + 1) + 最小値)
        col_1 = Int(Rnd() * 256)
        col_2 = Int(Rnd() * 256)
        col_3 = Int(Rnd() * 256)
        
        ReDim Preserve col_list(i)
        col_list(i) = RGB(col_1, col_2, col_3)
    Next i
End Sub

Sub change_color()
    'Set rng = Selection 'アクティブセルの場合
    Set rng = Range("A1", "AC20") 'ここを毎回指定
    
    For Each c In rng
        i = Int(Rnd() * col_max + 1)
        c.Cells.Font.Color = col_list(i)
    Next c
End Sub

init_color()であらかじめ文字色を規定数作成しています。
これはExcelでは1ブックあたりの書式の上限数が決まっているからです。

不親切でおなじみの公式サポートページでは以下のように書かれています。

固有のフォントの種類
1,024 個のグローバル フォントを使用可能 (ブックあたり 512 個)

support.microsoft.com

文字色は512種類が限界みたいですね（おそらく）
このマクロは実行毎に200色ランダム生成するので3回目で以下のエラーが出ます🤦‍♂️

その際は一度ブックを閉じないとフィーバーできないんですよね…。
Const col_max As Integer = 200の200を減らせばいい話ですが。

文字色を生成した後はApplication.Wait [Now()] + 500 / 86400000で
0.5秒ずつ時間を止めつつchange_color()でセルごとに色を変更しています。

86400000は1日を秒換算した値みたいですね。なるほど😙

動かすとこんな感じ！
youtu.be