VBA - 显示时钟时间，精度小于一秒

在VBA中，我们经常需要在Excel或其他Office应用程序中显示一个实时的时钟。虽然VBA本身没有提供直接获取精确到毫秒级的时间的函数，但我们可以通过一些技巧来实现这个目标。

vba
Option Explicit
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type
Sub DisplayClock()
    Dim sysTime As SYSTEMTIME
    Dim currentTime As Date
    Dim milliseconds As Integer
    
    GetSystemTime sysTime
    
    currentTime = TimeSerial(sysTime.wHour, sysTime.wMinute, sysTime.wSecond)
    milliseconds = sysTime.wMilliseconds
    
    ' 在Excel的A1单元格中显示时间
    Range("A1").Value = Format(currentTime, "hh:mm:ss") & "." & milliseconds
End Sub

vba
Option Explicit
Private Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)
Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
End Type
Sub DisplayClock()
    Dim sysTime As SYSTEMTIME
    Dim currentTime As Date
    Dim milliseconds As Integer
    
    GetSystemTime sysTime
    
    currentTime = TimeSerial(sysTime.wHour, sysTime.wMinute, sysTime.wSecond)
    milliseconds = sysTime.wMilliseconds
    
    ' 在Excel的A1单元格中显示时间
    Range("A1").Value = Format(currentTime, "hh:mm:ss") & "." & milliseconds
End Sub
Sub StartClock()
    ' 设置每隔100毫秒执行一次DisplayClock子过程
    Application.OnTime Now + TimeValue("00:00:00"), "DisplayClock", , True
End Sub
Sub StopClock()
    ' 停止执行DisplayClock子过程
    Application.OnTime Now + TimeValue("00:00:00"), "DisplayClock", , False
End Sub