VBA宏在EXCEL中的应用时间控件.pdfVIP

实现每隔一定时间自动执行VBA 代码 这是一个关于时间的控制，程序一旦运行，控制权就交给了windows 操作系统，只有接到指定命令后才再 次把控制权交给excel，如： 代码如下： Option Explicit Dim NextTick Dim i Sub StartClock() UpdateClock End Sub Sub StopClock() On Error Resume Next Application.OnTime NextTick, UpdateClock, , False End Sub Sub UpdateClock() Dim xo As Integer Dim yo As Integer Dim i As Integer Dim x As Integer xo = Range(g2).Value yo = Range(h2).Value If Range(i2) = 1 Then i = -2 Else i = 0 End If x = xo + 3 If xo = yo Then Range(i2) = 1 ElseIf xo = 1 Then Range(i2) = 0 End If Cells(x, 3).Select NextTick = Now + TimeValue(00:00:02) TimeSerial(0, 0, 0.5) Application.OnTime NextTick, UpdateClock Range(g2).Value = xo + 1 + i Next i End Sub Sub UpdateClock2() Dim xo As Integer Dim yo As Integer Dim i As Integer Dim x As Integer xo = Range(g2).Value yo = Range(h2).Value If xo = 1 Then i = 0 ElseIf xo = yo + 1 Then i = -2 xo = yo - 1 End If x = xo + 3 Cells(x, 3).Select NextTick = Now + TimeValue(00:00:02) TimeSerial(0, 0, 0.5) Application.OnTime NextTick, UpdateClock Range(g2).Value = xo + 1 + i Next i End Sub Option Explicit Dim NextT Dim ixx Sub Stopcc() On Error Resume Next Application.OnTime NextT, goingupper, , False Application.OnTime NextT, goingdown, , False End Sub Sub goingupper() On Error Resume Next Application.OnTime NextT, goingdown, , False If ActiveWindow.ScrollRow = 1 Then Exit Sub ActiveWindow.SmallScroll Down:=-1 NextT = Now + TimeValue(00:00:02) TimeSerial(0, 0, 0.5) Application.OnTime NextT, goingupper End Sub Sub goingdown() On Error Resume Next Application.OnTime NextT, goingupper, , False ixx = Application.WorksheetFunction.CountA(Range(a:a)) + 15 If ActiveWindow.ScrollRow = ixx Then Exit Sub ActiveWindow.SmallScroll Down:=1 NextT = Now + TimeValue(00:00:02) TimeSerial(0, 0, 0.5) App