VBA宏在EXCEL中的应用时间控件.pdf
文本预览下载声明
实现每隔一定时间自动执行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
显示全部