【Excel/VBA/VBS】VBAでカウントダウンタイマーを作成する方法

今回は、Excel(VBA)でカウントダウンタイマーを作る方法について解説したいと思います。

また、後半ではさらに発展して、

Excelを開かなくてもVBSを使ってすぐカウントダウンタイマーを起動する方法についても解説します。

最後に完成したプログラムと実行例を表示しています。

ユーザーフォームを作成

Excelのシートにタイマーを表示することもできるんですが、

個人的には、ユーザーフォームを使った方が使い勝手がいいと思いました。

今回はこのようなフォームを使います。

テーマは、定時退社時刻までのカウントダウンタイマーです（笑）

ユーザーフォーム

定時までと書いている下の空白部分に、カウントダウンしていく時間を表示します。

VBAのコートを作成していく

さあ、準備ができたところで、いよいよ本格的にプログラムを打ち込んでいきます。

timerというプロシージャを作り、その中にコードを追記していきます。

現在の時刻と退社時刻の差分を求める

ブログ編集の時間の都合で、定時を23時にしていますが、

17時でも18時でも全く問題はありません。

Sub timer()
    '現在の時刻と退社時刻の差分を求める｡
    Dim nowTime, onTime, diffTime As Date
    nowTime = CDate(Time)
    onTime = CDate("23:00:00")
    diffTime = Format(onTime - nowTime,"hh:nn:ss")
End Sub

nowTimeは現在の時刻、onTimeは退社時刻、diffTimeはその差分の時刻です。

最後のdiffTimeはこの後も使います。

CDate関数は、Date型に変換する関数です。

Format関数は、変数を指定する形式で表示するための関数です。

関数の説明を始めるとキリがないので、関数の説明に関しては、外部サイトにお任せします（笑）

VBAの関数について

VBA関数｜エクセルの神髄 (excel-ubara.com)

エクセルの神髄というサイトはExcelの関数や基本的な操作など幅広く掲載されていて、

個人的によく利用させていただいてます。

時間/分/秒に分ける

　'時/分/秒に分ける
    Dim diffSecond, diffMinute, diffHour As Integer
    diffSecond = Second(diffTime)
    diffMinute = Minute(diffTime)
    diffHour = Hour(diffTime)

ここでは、diffTimeで取得した差分の時刻を、〇時間、〇分、〇秒に分けていきます。

diffSecondが秒、diffMinuteが分、diffHourが時間の変数です。

カウントダウン部分の本体を入力

　Dim limit As Date, cnt_d, rng As Double
    limit = DateAdd("s", diffSecond, Time) '現在時刻に指定秒を足す
    limit = DateAdd("n", diffMinute, limit) '現在時刻に指定分を足す
    limit = DateAdd("h", diffHour, limit) '現在時刻に指定時間を足す
    rng = 0 '一時停止の時間リセット
    UserForm1.Show vbModeless 'タイマーをモードレス表示
    UserForm1.Repaint '強制表示
    
    Do
        cnt_d = DateDiff("s", Time, limit) + rng '指定時刻 - 現在時刻 (+ 一時停止)
        UserForm1.Label3 = Format(TimeSerial(0, 0, cnt_d), "hh:nn:ss") '時:分:秒 で表示
        
        If UserForm1.Label3 = "0:00:00" Then Exit Do 'ゼロになったらDoを抜ける
        DoEvents 'イベントを実行
    Loop
　Unload UserForm1

この部分に関しては、別の方のブログを参考に（というかほぼそのまま利用させていただいています…）作りました。

参照

意外と簡単！ExcelVBAでカウントダウンタイマーを作る方法 *Ateitexe

カウントダウンを表示する場所をテキストボックスからラベルに変更しているのと、

rngをユーザーフォームでは使用しないため、Publicで宣言からDim宣言に格を下げるなど、

少し変更を加えています。

VBAプログラムは完成

ここまでで、VBAのプログラムは完成しました。

ですので、Excelファイルを開いてシートにマクロと紐づけたボタンを作ってマクロを実行すれば、

タイマーが起動します。

しかし、マクロを実行するためだけにExcelを開くのもなかなか面倒ですよね…？

ということで、ここでVBSが登場します。

VBSのサンプルコードについて解説します。

vbsファイルのサンプルコード

Dim ExApp
Set ExApp = CreateObject("Excel.Application")

'ファイル開く（マクロが組まれているファイルのパスを入力）
ExApp.Workbooks.Open "C:\Users\ユーザー\デスクトップ\タイマー.xlsm"

'エラーを無視
On Error Resume Next

'マクロ実行
ExApp.Application.Run "timer"

'エラーが発生したとき
If Err.Number = "800A9C68" Then
	Err.Clear
End If

'エラー無視を解除
On Error Goto 0

'ファイル閉じる
ExApp.Quit
set ExApp = Nothing

コピペしてもらって構わないです。

ただ、マクロのExcelファイルのパスのところは、そのままだと起動できませんので、

適当なパスを入力してくださいね。

メモ帳にコピペして、拡張子をvbsにして保存します。

その際、文字コードをANSIにするのを忘れないでください。

おそらく、UTF-8とかだとエラーが出たような…。

エラー回避

上のコードではエラー処理も記載しています。

途中でマクロを終了した場合に"800A9C68“というエラーコードのエラーが出るみたいです。

それが出た時に、ポップアップが出てくると鬱陶しいため、その対処です。

記載しておけば、800A9C68というエラーコードのエラーの場合は処理を続行してくれます。

ただ、タイプミスなどがあった場合は別のエラーが出るので、

その場合は適切に対処をお願いします。

まとめ

VBAコード↓

Sub timer()
    
    '現在の時刻と退社時刻の差分を求める｡
    Dim nowTime, onTime, diffTime As Date
    nowTime = CDate(Time)
    onTime = CDate("23:00:00")
    diffTime = Format(onTime - nowTime, "hh:nn:ss")
    
    '時/分/秒に分ける
    Dim diffSecond, diffMinute, diffHour As Integer
    diffSecond = Second(diffTime)
    diffMinute = Minute(diffTime)
    diffHour = Hour(diffTime)
    
    Dim limit As Date, cnt_d, rng As Double
    limit = DateAdd("s", diffSecond, Time) '現在時刻に指定秒を足す
    limit = DateAdd("n", diffMinute, limit) '現在時刻に指定分を足す
    limit = DateAdd("h", diffHour, limit) '現在時刻に指定時間を足す
    rng = 0 '一時停止の時間リセット
    UserForm1.Show vbModeless 'タイマーをモードレス表示
    UserForm1.Repaint '強制表示
    
    Do
        cnt_d = DateDiff("s", Time, limit) + rng '指定時刻 - 現在時刻 (+ 一時停止)
        UserForm1.Label3 = Format(TimeSerial(0, 0, cnt_d), "hh:nn:ss") '時:分:秒 で表示
        
        If UserForm1.Label3 = "0:00:00" Then
            Exit Do 'ゼロになったらDoを抜ける
        End If
        
        DoEvents 'イベントを実行
        
    Loop
    
    Unload UserForm1

End Sub

VBSコード↓

Dim ExApp
Set ExApp = CreateObject("Excel.Application")

'ファイル開く
ExApp.Workbooks.Open "C:\Users\hirok\OneDrive\デスクトップ\タイマー.xlsm"

'エラーを無視
On Error Resume Next

'マクロ実行
ExApp.Application.Run "timer"

'エラーが発生したとき
If Err.Number = "800A9C68" Then
	Err.Clear
End If

'エラー無視を解除
On Error Goto 0

'ファイル閉じる
ExApp.Quit
set ExApp = Nothing

実行例↓

実行中の様子

vbsファイルから実行すると、↑のカウントダウンの時間を表示したユーザーフォームのみが表示され、

Excelファイルは見かけ上開いていない状態です。（タスクバーにExcelのアイコンは表示されません）

ただ、タスクマネージャーで見るとExcelは動いています（VBAはExcelで作っていますので…）

VBSから開く場合は、このままだとタスクバーに何も表示されないので気を付けてください。

Excelのアイコンを表示させたい場合は、

ExApp.Visible=True

という一行をVBSファイルの序盤に追記すればOKです。

ということで、今回の記事はここまでです。

何か参考になる情報があれば嬉しいです。

過去にもマクロの記事を1つ作っているので、興味があれば覗いてみてください。

最後までお読みいただき、ありがとうございました。

Excel,PCExcel,PC,VBA,VBS,マクロ

Posted by ぴろたん