Question

Dim StartTime As Date
Public Declare Function SetTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long

Public Declare Function KillTimer Lib "user32" ( _
ByVal HWnd As Long, ByVal nIDEvent As Long) As Long

Public TimerID As Long, TimerSeconds As Single, tim As Boolean
Dim Counter As Long

Sub StartTimer()
'~~ Set the timer for 1 second
TimerSeconds = 1
TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
End Sub

'~~> End Timer
Sub EndTimer()
On Error Resume Next
KillTimer 0&, TimerID
End Sub

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
ByVal nIDEvent As Long, ByVal dwTimer As Long)
'~~> Update value in Sheet 1
Sheet1.Range("H6").Value = Time - StartTimer
End Sub
Public Sub sheet()
Sheets("1").Activate
StartTime = Time
Call Module1.StartTimer
End Sub

我想编写一个代码，显示用户在工作表上工作的时间。

示例当用户单击开始按钮时，sheet1中有一个开始按钮，然后它将激活sheet2，然后计时器将在单元格A1中运行。如果计时器是30分钟，则工作簿保存＆amp;关闭。

Answer 1

试试这个

创建按钮并分配给以下宏

Option Explicit
Sub NewTimer()
    Dim Start As Single
    Dim Cell As Range
    Dim CountDown As Date

    '// Store timer as variable
    Start = Timer

    '// Format cell A1 to 24Hrs eg: 00:00:00
    With Range("A1")
        .NumberFormat = "HH:MM:SS;@"
    End With
    Set Cell = Sheet1.Range("A1")

    '// This is the starting value. 30 Second
    CountDown = TimeValue("00:00:30")

    '// Set cell to the starting value
    Cell.Value = CountDown

    'Keep looping until A1 hits zero or
    Do While Cell.Value > 0
        'Update the cell. Timer - Starting number is seconds
        Cell.Value = CountDown - TimeSerial(0, 0, Timer - Start)
        DoEvents
    Loop

    ThisWorkbook.Save
    ThisWorkbook.Close
    Application.Quit

End Sub

感谢Dick Kusleika见Example

Excel VBA上的计时器

1 个答案: