Excel VBAでAmong Usのタスクっぽいプログレスバーを作ってみた
最近話題のゲーム、宇宙人狼こと『Among Us』。
このゲームが人気な点はやはりプレイヤー同士が疑い合い、疑心暗鬼になりながらもインポスター(人狼)を見つけ出すという人狼ゲームのおもしろさです。ただ、それ以上にこのゲームを魅力的にしたのは、そのゲーム内容とは真逆のイメージの"ポップ"なキャラクターや絵のタッチです。
そこで今回はそんな"可愛らしい"Among Usのキャラクターを拝借しExcel VBAのプログレスバーを作成してみました。作中では「タスク」と呼ばれる作業がありますがその中でも「ダウンロードタスク」をイメージして作成しています。
ただ、このプログレスバーはビジュアル面にステータスを全振りしたため基本的に作業処理は重くなるという致命的な欠陥を持っています。
しかしながらこのプログレスバーには下記のようなさまざまな手法が潜んでいます。
・Excel VBAで音楽を鳴らす
・UserFormの[×]ボタンが押された時に条件分岐で処理を行う
・処理にかかる時間を推測し、残り時間を表示する
Among Usに興味のある方もない方もExcel VBAのいくつかのテクニックが学べるはずので、「使えねえプログレスバーだな」と思わずに「こういう方法もあるのか！」と何かしら学べる点を見つけて何かしらのの知識を持って帰って頂けたらもらえたら幸いです。
Among Usのタスクっぽいプログレスバー
上記の動画を見れば今回作成した“Among Usのタスクっぽいプログレスバー"のシステムが理解できると思います。プログレスバーに使われている言語が英語なのは原作リスペクトのためです。(実はこのプログレスバーを作ったのが日本語訳がまだないAmong Us初期の頃だったためというのは内緒)
プログレスバーに使用している素材をはじめとしたExcelファイルは下記よりダウンロードできます。ダウンロード後、Excelファイルを開き、シート上にあるボタンを押せば動画のようなプログレスバーが表示されます。
AmongUs_ProgressBar (クリックでzipファイルダウンロード)
プログレスバーのコード
このプログレスバーはUserFormだけで全て完結しません。メインの処理を行なっている標準モジュール上でもいくつかの処理を書いておく必要があるので注意してください。
基本的には下記の「標準モジュールコード」に書かれている「何らかの処理」の部分を実際に行う処理にすればOKです。
またダウンロードしたExcelファイルでうまくいかない場合は下記コードをコピペして実行してみてください。UserFormについてもコントロールさえ存在していれば自動で大きさや位置を設定するようになっているので、下項目の画像を参考にUserFormを作成して下さい。(※この時、各コントロールの配置位置の前後は非常に重要なのでうまく並び替えてください)
標準モジュールコード
Option Explicit
Sub main()
UserForm1.Show vbModeless
Dim Percent As String
Dim EstimatedTime As Double
Dim EstimatedTime_msg As String
Dim i As Long
Dim j As Long
Dim tmp_i As Long: tmp_i = 1
Dim cnt As Long: cnt = 5000
Dim tmp_time As Double: tmp_time = Timer
For i = 1 To cnt
'何らかの処理 ---------------------------------------------------------
For j = 1 To 100000
Next j
'----------------------------------------------------------------------
If (Timer - tmp_time) > 1 Then
EstimatedTime = (Timer - tmp_time) * (cnt - tmp_i) / (i - tmp_i)
tmp_i = i
tmp_time = Timer
EstimatedTime_msg = "Estimated Time： " & _
Int(EstimatedTime / 3600) & "hr " & _
Int(EstimatedTime / 60) Mod 60 & "m " & _
Int(EstimatedTime) Mod 60 & "s"
UserForm1.Label2.Caption = EstimatedTime_msg
With UserForm1.Label1
If .Caption = "Running." Then
.Caption = "Running.."
ElseIf .Caption = "Running.." Then
.Caption = "Running..."
ElseIf .Caption = "Running..." Then
.Caption = "Running."
End If
End With
End If
Percent = Str(Int(100 * (i / cnt))) & "%"
UserForm1.Image2.Width = 300 * (i / cnt)
UserForm1.Label3.Caption = Percent
DoEvents
Next i
UserForm1.Tag = "True"
Unload UserForm1
End Sub
UserFormコード
#If Win64 Then
Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
#Else
Private Declare Function mciSendString Lib "winmm" Alias "mciSendStringA" _
(ByVal lpstrCommand As String, ByVal lpstrReturnString As String, _
ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
#End If
Dim se1 As String
Dim se2 As String
Dim se3 As String
Dim html1 As String
Dim html2 As String
Dim gif1 As String
'-----------------------------------------------------------------------------------------------------
Private Sub UserForm_Initialize()
Dim wbDir As String
wbDir = ActiveWorkbook.Path
se1 = wbDir & "\emergency_se.mp3"
se2 = wbDir & "\completed_se.mp3"
se3 = wbDir & "\close_se.mp3"
html1 = wbDir & "\running.html"
html2 = wbDir & "\emergency.html"
gif1 = wbDir & "\bar.gif"
With Me
.Width = 400
.Height = 200
.Tag = "False"
.Caption = "Task is Running"
.BackColor = RGB(59, 99, 140)
End With
With Me.WebBrowser1
.Left = -10
.Top = -30
.Width = Me.Width + 10
.Height = 250
.Navigate html1
End With
With Me.Frame1
.Caption = ""
.Left = 0
.Top = 115
.Width = Me.Width
.Height = Me.Height - .Top
.BackColor = RGB(59, 99, 140)
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
End With
With Me.Frame2
.Caption = ""
.Left = 110
.Top = 0
.Width = 160
.Height = 115
.BackColor = RGB(59, 99, 140)
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
End With
With Me.Image3
.Picture = LoadPicture(gif1)
.Left = 20
.Top = 0
.Width = 300
.Height = 30
.BorderStyle = fmBorderStyleNone
.PictureSizeMode = fmPictureSizeModeStretch
.BackStyle = fmBackStyleTransparent
End With
With Me.Image2
.Left = 20
.Top = 0
.Width = 200
.Height = 30
.BackColor = RGB(50, 127, 1)
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
End With
With Me.Image1
.Left = 20
.Top = 0
.Width = 300
.Height = 30
.BackColor = RGB(255, 255, 255)
.BorderStyle = fmBorderStyleNone
.SpecialEffect = fmSpecialEffectFlat
End With
With Me.Label1
.Top = 48
.Left = 23
.Width = 250
.Height = 35
.Caption = "Running..."
.BackStyle = fmBackStyleTransparent
.ForeColor = &HFFFFFF
.Font = "Calibri"
.Font.Size = 28
.Font.Bold = True
End With
With Me.Label2
.Top = 32
.Left = 25
.Width = 400
.Height = 35
.Caption = "Estimated Time： Being calculated"
.BackStyle = fmBackStyleTransparent
.ForeColor = &HFFFFFF
.Font = "Calibri"
.Font.Size = 18
.Font.Bold = True
End With
With Me.Label3
.Top = -1
.Left = 324
.Width = 200
.Height = 50
.Caption = "100%"
.BackStyle = fmBackStyleTransparent
.ForeColor = &HFFFFFF
.Font = "Calibri"
.Font.Size = 24
.Font.Bold = True
End With
End Sub
'-----------------------------------------------------------------------------------------------------
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Dim i As Long
If Me.Tag = "False" Then
If CloseMode = vbFormControlMenu Then Cancel = True
DoEvents
With Me
.Tag = "True"
.Frame1.Visible = False
.Frame2.Visible = False
.WebBrowser1.Navigate html2
End With
'se1(emergency_se.mp3)を再生
Call mciSendString("play " & se1, "", 0, 0)
For i = 1 To 20000
DoEvents
Next i
Cancel = False
MsgBox "Forced Termination"
End
ElseIf Me.Tag = "True" Then
'se2(completed_se.mp3)を再生
Call mciSendString("play " & se2, "", 0, 0)
For i = 1 To 3000
DoEvents
Next i
With UserForm1.Label1
.Caption = ""
.Left = 16
End With
UserForm1.Label2.Caption = "Complete"
For i = 1 To 10000
DoEvents
Next i
'se3(close_se.mp3)を再生
Call mciSendString("play " & se3, "", 0, 0)
For i = 1 To 1000
DoEvents
Next i
Cancel = False
Else
Cancel = False
End If
End Sub
まとめ
今回は「Among Usのタスクっぽいプログレスバー」の紹介でした。
コードについて深い解説はしていませんが読めば何をしているかは理解できると思います。
ここでは冒頭で言っていた手法の答えを簡単にまとめておきます。
・UserForm上でgif画像を動かす
→「WebBrowser」を使用 ※imageの場合はアニメーションが動かないため
ただWebBrowserは必ず最前面に設置され全てのコントロールが隠れてしまう
唯一「Frame」のみWebBrowserより前側に設置できるためうまく利用する
・Excel VBAで音楽を鳴らす
→ Windows API「mciSendString関数」を使用
・UserFormの[×]ボタンが押された時に条件分岐で処理を行う
→ UserForm_QueryCloseイベントとTagプロパティを組み合わせる
・処理にかかる時間を推測し、残り時間を表示する
→ 現在の処理回数を全体の処理回数で割る
(参考：【ExcelVBA】残りの処理時間と進捗をステータスバーに表示する方法)