How do I show a running clock in Excel?

匿名 (未验证) 提交于 2019-12-03 00:56:02

问题:

I'd like to show a clock in cell A1 of Excel 2007. I'm familiar with NOW() and TODAY() but it doesn't refresh itself every 1 minute like I want it to. You know, like a running clock. I just want the current time in h:mm to be in cell A1. Is this possible?

From this clock I will do further calculations like How long has it been since I last did Activity X, Y, and Z. Thanks SO.

回答1:

See the below code (taken from this post)

Put this code in a Module in VBA (Developer Tab -> Visual Basic)

Dim TimerActive As Boolean Sub StartTimer()     Start_Timer End Sub Private Sub Start_Timer()     TimerActive = True     Application.OnTime Now() + TimeValue("00:01:00"), "Timer" End Sub Private Sub Stop_Timer()     TimerActive = False End Sub Private Sub Timer()     If TimerActive Then         ActiveSheet.Cells(1, 1).Value = Time         Application.OnTime Now() + TimeValue("00:01:00"), "Timer"     End If End Sub 

You can invoke the "StartTimer" function when the workbook opens and have it repeat every minute by adding the below code to your workbooks Visual Basic "This.Workbook" class in the Visual Basic editor.

Private Sub Workbook_Open()     Module1.StartTimer End Sub 

Now, every time 1 minute passes the Timer procedure will be invoked, and set cell A1 equal to the current time.



回答2:

Found the code that I referred to in my comment above. To test it, do this:

  1. In Sheet1 change the cell height and width of say A1 as shown in the snapshot below.
  2. Format the cell by right clicking on it to show time format
  3. Add two buttons (form controls) on the worksheet and name them as shown in the snapshot
  4. Paste this code in a module
  5. Right click on the Start Timer button on the sheet and click on Assign Macros. Select StartTimer macro.
  6. Right click on the End Timer button on the sheet and click on Assign Macros. Select EndTimer macro.

Now click on Start Timer button and you will see the time getting updated in cell A1. To stop time updates, Click on End Timer button.

Code (TRIED AND TESTED)

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  '~~> Start Timer 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("A1").Value = Time End Sub 

SNAPSHOT



标签
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!