"Martyn" <
[email protected]> wrote in message
Martyn!
Here is my VBA-module "Timer" with two different ways using
Excel-Timer and Windows-Timer. Please post further quesions here.
Dirk
Option Explicit
Private Declare Function SetTimer Lib "user32" (ByVal HWnd As Long,
ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As
Long) As Long
Private Declare Function KillTimer Lib "user32" (ByVal HWnd As Long,
ByVal nIDEvent As Long) As Long
Private timExcelTimerOff As Boolean
Private timWindowsTimerId As Long
Private timWindowsTimerOn As Boolean
Public Function timStartWindowsTimer()
' Der Timer darf nur einmal gestartet werden!
If Not timWindowsTimerOn Then
timWindowsTimerId = SetTimer(0&, 0&, 100&, AddressOf
timWindowsTimerEvent)
timWindowsTimerOn = True
End If
End Function
Public Function timStopWindowsTimer()
On Error Resume Next
If timWindowsTimerOn Then
KillTimer 0&, timWindowsTimerId
timWindowsTimerOn = False
End If
End Function
Public Function timWindowsTimerEvent(ByVal HWnd As Long, ByVal uMsg As
Long, ByVal nIDEvent As Long, ByVal dwTimer As Long)
On Error Resume Next
timCustomTimerEvent
End Function
Public Function timStartExcelTimer()
Dim timNextTime As Double
timExcelTimerOff = False
timNextTime = Now + TimeSerial(0, 0, 1)
Application.OnTime timNextTime, "timExcelTimerEvent", False
End Function
Public Function timStopExcelTimer()
' Wie kann das Excel-Timer-Ereignis so gelöscht werden,
' dass es auch vom Workbook_BeforeClose aus funktioniert?
timExcelTimerOff = True
End Function
Public Function timExcelTimerEvent()
If Not timExcelTimerOff Then
timCustomTimerEvent
timStartExcelTimer
End If
End Function
Public Function timCustomTimerEvent()
Dim vCell As Range
Set vCell = WS1.Cells(1, 1)
If vCell.Interior.ColorIndex = 6 Then
vCell.Interior.ColorIndex = 4
Else
vCell.Interior.ColorIndex = 6
End If
WS1.Cells(1, 1) = Time
End Function
<<<
