AW: Drei unabhängige Timer in einem Excelsheet?
28.06.2005 12:47:03
PeterP
So, ich habs!
Vielen Dank an Jörg Lorenz (http://www.excel-vba.de), dessen Code ich etwas modifiziert verwendet habe (geht sicher auch kürzer, aber der Übersichtlichkeit halber hab ichs nicht weiter zusammengefaßt):
Code im Modul
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
Public bolTimer1Erlaubt As Boolean
Public lngZaehler1 As Long
Public bolTimer2Erlaubt As Boolean
Public lngZaehler2 As Long
Public bolTimer3Erlaubt As Boolean
Public lngZaehler3 As Long
Dim lngTimer1 As Long
Dim lngIntervall1 As Long
Dim lngTimer2 As Long
Dim lngIntervall2 As Long
Dim lngTimer3 As Long
Dim lngIntervall3
'-----------------------------------------------------------------------------------------
'Aufruf:
'Legt für den Timer das Intervall fest und ruft ihn auf:
Sub Zeit1FestLegen()
'Intervall festlegen (Millisekunden; 1000 ms = 1 s):
lngIntervall1 = ThisWorkbook.Sheets(1).Range("d6").Value
If bolTimer1Erlaubt = False Then
lngTimer1 = SetTimer(0, 0, lngIntervall1, AddressOf Timer1Anzeige): bolTimer1Erlaubt = True
End If
End Sub
'-----------------------------------------------------------------------------------------
'Beendet den Timer:
Sub Timer1Beenden()
Call KillTimer(0, lngTimer1): bolTimer1Erlaubt = False
End Sub
'-----------------------------------------------------------------------------------------
'Setzt den Zähler auf 0 zurück:
Sub Reset1()
lngZaehler1 = 0
TuEs1
End Sub
Sub TuEs1()
'############################################################
'Hier festlegen, was im festgelegten Intervall passieren soll:
ThisWorkbook.Sheets(1).Range("A6") = CDate(Date & " " & Time)
ThisWorkbook.Sheets(1).Range("B6") = lngZaehler1
'############################################################
End Sub
'Festlegen, was im festgelegten Intervall passieren soll:
Sub Timer1Anzeige(ByVal hWnd&, ByVal Msg&, ByVal idEvent&, ByVal dwTime&)
Dim bolTemp1 As Boolean
On Error Resume Next
If bolTemp1 = False Then
bolTemp1 = True: lngZaehler1 = lngZaehler1 + 1
TuEs1
bolTemp1 = False
End If
End Sub
'-----------------------------------------------------------------------------------------
'Aufruf:
'Legt für den Timer das Intervall fest und ruft ihn auf:
Sub Zeit2FestLegen()
'Intervall festlegen (Millisekunden; 1000 ms = 1 s):
lngIntervall2 = ThisWorkbook.Sheets(1).Range("d9").Value
If bolTimer2Erlaubt = False Then
lngTimer2 = SetTimer(0, 0, lngIntervall2, AddressOf Timer2Anzeige): bolTimer2Erlaubt = True
End If
End Sub
'-----------------------------------------------------------------------------------------
'Beendet den Timer:
Sub Timer2Beenden()
Call KillTimer(0, lngTimer2): bolTimer2Erlaubt = False
End Sub
'-----------------------------------------------------------------------------------------
'Setzt den Zähler auf 0 zurück:
Sub Reset2()
lngZaehler2 = 0
TuEs2
End Sub
Sub TuEs2()
'############################################################
'Hier festlegen, was im festgelegten Intervall passieren soll:
ThisWorkbook.Sheets(1).Range("A9") = CDate(Date & " " & Time)
ThisWorkbook.Sheets(1).Range("B9") = lngZaehler2
'############################################################
End Sub
'Festlegen, was im festgelegten Intervall passieren soll:
Sub Timer2Anzeige(ByVal hWnd&, ByVal Msg&, ByVal idEvent&, ByVal dwTime&)
Dim bolTemp2 As Boolean
On Error Resume Next
If bolTemp2 = False Then
bolTemp2 = True: lngZaehler2 = lngZaehler2 + 1
TuEs2
bolTemp2 = False
End If
End Sub
'-----------------------------------------------------------------------------------------
'Aufruf:
'Legt für den Timer das Intervall fest und ruft ihn auf:
Sub Zeit3FestLegen()
'Intervall festlegen (Millisekunden; 1000 ms = 1 s):
lngIntervall3 = ThisWorkbook.Sheets(1).Range("d12").Value
If bolTimer3Erlaubt = False Then
lngTimer3 = SetTimer(0, 0, lngIntervall3, AddressOf Timer3Anzeige): bolTimer3Erlaubt = True
End If
End Sub
'-----------------------------------------------------------------------------------------
'Beendet den Timer:
Sub Timer3Beenden()
Call KillTimer(0, lngTimer3): bolTimer3Erlaubt = False
End Sub
'-----------------------------------------------------------------------------------------
'Setzt den Zähler auf 0 zurück:
Sub Reset3()
lngZaehler3 = 0
TuEs3
End Sub
Sub TuEs3()
'############################################################
'Hier festlegen, was im festgelegten Intervall passieren soll:
ThisWorkbook.Sheets(1).Range("A12") = CDate(Date & " " & Time)
ThisWorkbook.Sheets(1).Range("B12") = lngZaehler3
'############################################################
End Sub
'Festlegen, was im festgelegten Intervall passieren soll:
Sub Timer3Anzeige(ByVal hWnd&, ByVal Msg&, ByVal idEvent&, ByVal dwTime&)
Dim bolTemp3 As Boolean
On Error Resume Next
If bolTemp3 = False Then
bolTemp3 = True: lngZaehler3 = lngZaehler3 + 1
TuEs3
bolTemp3 = False
End If
End Sub
Code im Sheet (8 Buttons, Intervall steht in den entsprechenden Zellen)
Option Explicit
Private Sub cmdTimer_Click()
If cmdTimer.Caption = "Alle Timer einschalten" Then
cmdTimer.Caption = "Alle Timer ausschalten"
Call Timer1
Call Timer2
Call Timer3
Else
cmdTimer.Caption = "Alle Timer einschalten"
Call Timer1
Call Timer2
Call Timer3
End If
End Sub
Private Sub cmdReset_Click()
Reset1
Reset2
Reset3
End Sub
Private Sub cmdTimer1_Click()
Call Timer1
End Sub
Private Sub cmdReset1_Click()
Reset1
End Sub
Private Sub cmdTimer2_Click()
Call Timer2
End Sub
Private Sub cmdReset2_Click()
Reset2
End Sub
Private Sub cmdTimer3_Click()
Call Timer3
End Sub
Private Sub cmdReset3_Click()
Reset3
End Sub
Sub Timer1()
If cmdTimer1.Caption = "Timer1 einschalten" Then
Zeit1FestLegen
cmdTimer1.Caption = "Timer1 ausschalten"
Else
Timer1Beenden
cmdTimer1.Caption = "Timer1 einschalten"
End If
End Sub
Sub Timer2()
If cmdTimer2.Caption = "Timer2 einschalten" Then
Zeit2FestLegen
cmdTimer2.Caption = "Timer2 ausschalten"
Else
Timer2Beenden
cmdTimer2.Caption = "Timer2 einschalten"
End If
End Sub
Sub Timer3()
If cmdTimer3.Caption = "Timer3 einschalten" Then
Zeit3FestLegen
cmdTimer3.Caption = "Timer3 ausschalten"
Else
Timer3Beenden
cmdTimer3.Caption = "Timer3 einschalten"
End If
End Sub
Code im Workbook:
'Beim Schließen der Mappe den Timer beenden:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If bolTimer1Erlaubt = True Then Timer1Beenden
If bolTimer2Erlaubt = True Then Timer2Beenden
If bolTimer3Erlaubt = True Then Timer3Beenden
End Sub
Vielleicht kann es jemand gebrauchen ...
Gruß
Peter