自動化・効率化ならKTパソコンスクール

Excel VBAで超簡単にデジタル時計を作成する方法です。⇓

'方法1

Sub test1()

    Do While True

        Range("A1") = Format(Now, "hh:nn:ss")

    Loop

End Sub

Do While True～Loopで無限ループを作ってその中で時刻を取得して表示します。ただ、この方法だと途中で時計を止めることができないのとCPUに負荷がかかりすぎるので、

①　Sleepを使って処理を一時停止する。

②　DoEventsを使って途中で停止できるようにOSに制御を渡す。

③　GetAsyncKeyStateを使ってキー入力で時計を止められるようにする。

SleepとGetAsyncKeyStateはWindows APIを使用するのでコードの一番上に次のコードを入れておきます。「#If VBA7 Then」はOffice2010以降64bitの場合です。「#Else」はそれ以外のバージョンのOfficeの場合です。おまじないだと思ってください。

#If VBA7 Then

Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) _

As Long

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)

#Else

Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long

Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

#End If

コード全体は以下です。⇓

Option Explicit



#If VBA7 Then

Declare PtrSafe Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) _

As Long

Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal ms As LongPtr)

#Else

Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long

Declare Sub Sleep Lib "kernel32" (ByVal ms As Long)

#End If



'方法2

Sub test2()    

    Do While True

        Range("A1") = Format(Now, "hh:nn:ss")

        

        'Escキーが押されたら時計停止

        If GetAsyncKeyState(27) <> 0 Then

            Exit Do

        End If

        

        Sleep 1 '1ミリ秒待つ



        DoEvents 'OSへ制御を渡す

    Loop

End Sub