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

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

作ってみたら意外と少ないコードでできるもんだなぁと思ったのでご紹介。わたしは当時Excel2003で作りましたが、そんなに特殊なコードは使ってないので恐らく2007以降でも動く…はずです(たぶん)。実用的かどうかはさておき、勉強のとっかかりにどうぞー。


実装

標準モジュール

130131-1

ではまず、B2セルに分、D2セルに秒の数値が入るようにシートに記入して(枠はなくても構いません)、こちらの記事を参考にプログラム起動用のボタンを作ってみてください。標準モジュールに書くコードはこちらです。

Public rng As Double '一時停止時間格納用

Sub timer()
  Dim limit As Date, cnt_d As Double

  limit = DateAdd("s", Range("D2"), Time) '現在時刻に指定秒を足す
  limit = DateAdd("n", Range("B2"), limit) '現在時刻に指定分を足す
  rng = 0 '一時停止の時間リセット

  UserForm1.Show vbModeless 'タイマーをモードレス表示
  UserForm1.Repaint '強制表示

  Do
    cnt_d = (DateDiff("s", Time, limit) + rng) / 60 '指定時刻 - 現在時刻 (+ 一時停止) を秒で表して60で割ったもの
    UserForm1.TextBox1 = Int(cnt_d) & ":" & Format(Round((cnt_d - Int(cnt_d)) * 60, 0), "00") '分:秒 で表示
    If UserForm1.TextBox1 = "0:00" Then Exit Do 'ゼロになったらDoを抜ける

    DoEvents 'イベントを実行
  Loop

End Sub

コピペして貼り付けてください。プロシージャ名が「timer」なので、ボタンへの登録の際ご注意くださいね。

改善コードを記事末尾に追記しました。そちらのほうがスマートなコードとなっております。

ユーザーフォーム

Visual Basic Editorの[挿入]→[ユーザーフォーム]を選択すると、空のUserForm1というものができます。

130131-2

図のようにツールボックスから、ラベル、テキストボックス、コマンドボタンをひとつずつ配置します。(ラベルはプログラム上使っていないので、なくても動きます)

※ツールボックスが出ていない場合は、[表示]→[ツールボックス]を押してみてください。

ユーザーフォームのコード

130131-3

図の部分のUserFrom1を右クリック→[コードの表示]をクリックして、そこに以下をコピペします。

Private Sub CommandButton1_Click()
  Dim rng_s As Date

  rng_s = Time 'ストップボタンを押した時刻を取得
  MsgBox ("再開する場合はボタンを押してください") 'メッセージボックス

  rng = rng + DateDiff("s", rng_s, Time) 'ストップしていた間の秒数を取得して上書き
End Sub

Private Sub UserForm_Terminate()
  End '終了時にDoを抜ける
End Sub

はい、できました!

Excelに戻って、分と秒にお好きな数値を入れて、スタートボタンを押してみてください。意外と簡単ですよね?

解説

主に、3つの変数で出来ています。

  • limit … 現在時刻に指定分・指定秒を足した、到達時刻
  • cnt_d … 到達時刻から現在時刻を引いた秒数(一時停止時間もあればプラス)/60
  • rng … 一時停止していた秒数

limitからTime(現在時刻)を引いて、のちの計算のため60で割ってあるのがcnt_dです。日付や時間の差を計算してくれる関数、DateDiffは分、秒など特定の形式でしか表せないため、秒で出したものを60で割ったりなんかごねごねして、分:秒の形に成形しています。もしかしてもっとスマートなやり方あるのかな_(┐「ε:)_

改善コードを記事末尾に追記しました!

そのため、秒が1桁になったときに頭にゼロがつかないのがちょっと気持ち悪いところです。条件つけて1桁だったら頭にゼロを、ってことも出来るんですが、それで無駄なタイムラグとか生まれるのがやだなーと思って実装しませんでした。

やっぱり、Format(なかみ, "00")で括って1桁でも頭にゼロがつくようにしてみました。ちょっと入れ子すぎな感じもしますがw、やっぱゼロがあったほうが見た目が良いですねー。

rngはストップボタンを押してから再開するまでの秒数を格納しています。モジュールとユーザーフォーム両方で使う変数なので、Public変数で宣言しています。

一時停止機能がいらなければ、rngの変数宣言も、ユーザーフォームのコードもほとんどいらないですね。10~12行目のフォームが閉じるときのEndだけは必要です。

いかがでしたでしょうか?良かったら作ってみてくださいね!

追記

分:秒の形に成形するために60で割ったりなんだりやってたんですが、もっとシンプルな方法があるようでして、その部分を書き直しました。

標準モジュール

Public rng As Double '一時停止時間格納用

Sub timer()
  Dim limit As Date, cnt_d As Double

  limit = DateAdd("s", Range("D2"), Time) '現在時刻に指定秒を足す
  limit = DateAdd("n", Range("B2"), limit) '現在時刻に指定分を足す
  rng = 0 '一時停止の時間リセット

  UserForm1.Show vbModeless 'タイマーをモードレス表示
  UserForm1.Repaint '強制表示

  Do
    cnt_d = DateDiff("s", Time, limit) + rng '指定時刻 - 現在時刻 (+ 一時停止)
    UserForm1.TextBox1 = Format(TimeSerial(0, 0, cnt_d), "nn:ss") '分:秒 で表示
    If UserForm1.TextBox1 = "00:00" Then Exit Do 'ゼロになったらDoを抜ける

    DoEvents 'イベントを実行
  Loop

End Sub

ハイライト部分が変更されています。TimeSerialという関数があるんですね…!しらなかった…!

こちらの回答コードより勉強させて頂きました。私のコードは役に立たなかったようで…すみません(;´Д`)

2017/9/12追記

一時停止中もシートの操作ができるようにというリクエストをいただいたので、そちらの書き方もコメント欄に追記しました。

公開日:2013/01/31
更新日:2017/09/12

7件のコメント

  1. 藤田 より:

    参考になりましたが、一時停止している間にエクセルシートを障ることが出来ません。(メッセージボックス表示の為)なにかメッセージボックスの表示でなく、フォームのボタンで再開できないでしょうか

    • *you より:

      藤田さん、コメントありがとうございます。

      以下のようにすればできるんじゃないかと思います。UserForm1Label1をメッセージ用に使います。

      Module↓

      Public limit As Date '終了時刻格納用
      Public rng As Double '一時停止時間格納用
      Public canRunning As Boolean 'タイマー起動判定
      
      Sub timer() 'スタート
        limit = DateAdd("s", Range("D2"), Time) '現在時刻に指定秒を足す
        limit = DateAdd("n", Range("B2"), limit) '現在時刻に指定分を足す
        rng = 0 '一時停止の時間リセット
         
        UserForm1.Show vbModeless 'タイマーをモードレス表示
        
        canRunning = True
        Call runTimer 'タイマー起動
      End Sub
      
      Sub runTimer() 'タイマー起動
        Dim cnt_d As Double
       
        Do
          If canRunning = False Then Exit Do '停止指示があったらDoを抜ける
          
          cnt_d = DateDiff("s", Time, limit) + rng '指定時刻 - 現在時刻 (+ 一時停止)
          UserForm1.TextBox1 = Format(TimeSerial(0, 0, cnt_d), "nn:ss") '分:秒 で表示
          
          If UserForm1.TextBox1 = "00:00" Then 'ゼロになったら
            canRunning = False 'フラグを落としておく
            UserForm1.CommandButton1.Caption = "終了" 'ボタンの文字を変更
            Exit Do 'Doを抜ける
          End If
          
          DoEvents 'イベントを実行
        Loop
      End Sub
      

      UserForm↓

      Private rng_s As Date 'ストップボタンを押した時刻格納用
      
      Private Sub CommandButton1_Click()
        If CommandButton1.Caption = "停止中" Then
          'ボタンが「停止中」の場合
          rng = rng + DateDiff("s", rng_s, Time) 'ストップしていた間の秒数を取得して上書き
          CommandButton1.Caption = "ストップ" 'ボタンの文字を変更
          Label1.Caption = "" 'メッセージリセット
          
          canRunning = True
          Call runTimer 'タイマー再起動
          
        ElseIf CommandButton1.Caption = "終了" Then
          'ボタンが「終了」の場合
          End '終了
          
        Else
          'ボタンが「ストップ」の場合
          rng_s = Time 'ストップボタンを押した時刻を取得
          canRunning = False 'タイマー停止
          CommandButton1.Caption = "停止中"
          Label1.Caption = "再開する場合はボタンを押してください" 'メッセージ表示
          
        End If
      End Sub
       
      Private Sub UserForm_Terminate()
        End '終了
      End Sub
      
  2. 藤田 より:

    ありがとうございます。やってみます。

  3. 藤田 より:

    できました!!
    ばっちりです。
    ありがとうございました。

  4. 藤田 より:

    すぐに返事をしていただいてたのに見てなくてすみませんでした。どんなかたかブログ全体を拝見させていただいたら、なんとウエブでいろいろ検索しているときに拝見したページばかりでした。すごくお世話になっていました。漫画もツィッターで見かけたと思います。お忙しい中、著名な方に個人的な対応していただいて感謝しています。

    • *you より:

      そんなそんな、滅相もございません。レスポンスもらえることって少ないので嬉しかったです。ほかの記事もお役に立てていたようで光栄です(*´ω`*)


コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください

コメントは承認制ですので、反映までしばらくお待ち下さい。(稀にスパムの誤判定にて届かないこともあるようですので、必要な際はお問い合わせからお願い致します。)