More than 3 years have passed since last update.

【VBA】ストップウォッチの作り方

Posted at 2021-04-01

今回は、ストップウォッチの作り方です。

下記の動画のようなストップウォッチを作りました。
タスクの時間計測用に作ったものなので、もしよければ参考にしてください。

ソースコードは下記の通りです。

Private blnStop As Boolean
Private blnStart As Boolean

Sub StopWatch1()
    Dim dblTimer As Double
    Dim objWbk As Workbook                                          
    Set objWbk = ThisWorkbook
    
    If blnStart = True Then
        blnStop = True
        Exit Sub
    End If

    blnStart = True
    blnStop = False
    dblTimer = timer

    Do Until blnStop = True
　　　　dblLapse = (timer - dblTimer) + objWbk.Worksheets("Sheet1").Cells(2, 1)
        ' "時間"を求める
        intHour = Int(dblLapse / 3600)

        ' "分"を求める
        intMinute = Int((dblLapse Mod 3600) / 60)

        ' "秒"を求める
        dblSecond = ((dblLapse * 100) Mod 6000) / 100
        objWbk.Worksheets("Sheet1").Cells(2, 3) = intHour & "時間" & intMinute & "分" & dblSecond & "秒"
        DoEvents
    Loop

    objWbk.Worksheets("Sheet1").Cells(2, 1) = dblLapse
    blnStart = False
End Sub

詳細を説明します。

Private blnStop As Boolean
Private blnStart As Boolean

まずは、ストップとスタートを識別するためのフラグを用意します。

Dim dblTimer As Double
Dim objWbk As Workbook
Set objWbk = ThisWorkbook

次に上記の変数を用意します。
objWbkには、ストップウォッチを動かすエクセルファイルを指定するために用意します。
これが無いと、別のエクセルシートで作業する場合、別のエクセルシートに書き込みされてしまいます。

If blnStart = True Then
        blnStop = True
        Exit Sub
End If

上記のコードで、ストップウォッチが動いていればストップして、処理を終了するようにしています。

blnStart = True
blnStop = False

動いていなければ、スタートフラグをTrueに、ストップフラグをFalseにします。

dblTimer = timer

上記で、dblTimerに現在の時間（秒）を代入します。

timer関数については、下記のサイトを参照願います。
https://www.tipsfound.com/vba/05timer

Do Until blnStop = True
     dblLapse = (timer - dblTimer) + objWbk.Worksheets("Sheet1").Cells(2, 1)
     ' "時間"を求める
     intHour = Int(dblLapse / 3600)

     ' "分"を求める
     intMinute = Int((dblLapse Mod 3600) / 60)

     ' "秒"を求める
     dblSecond = ((dblLapse * 100) Mod 6000) / 100
     objWbk.Worksheets("Sheet1").Cells(2, 3) = intHour & "時間" & intMinute & "分" & dblSecond & "秒"
     DoEvents
Loop

上記で、時間を求めています。
Do Untilでは、条件式に一
致していない場合、処理を実行します。
今回は、「blnStop = True」でない場合に時間を求めます。