Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
628to632
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
628to632
628to632
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Drei unabhängige Timer in einem Excelsheet?

Drei unabhängige Timer in einem Excelsheet?
27.06.2005 15:56:01
PeterP
Hallo!
ich weiß - das gibts eigentlich nur in VB ... aber gibts für VBA nicht irgendwie eine Krücke, welche wenigstens mit einer sekundengenauen Auflösung arbeitet?
Gruß
Peter

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Drei unabhängige Timer in einem Excelsheet?
27.06.2005 16:02:53
Hajo_Zi
Hallo Peter,
was nun 1 oder 3?
Schaue mal auf meine Homepage da ist ein Beispiel auf der Seite VBA.
Beispieldatei
Falls Code vorhanden wurde dieser getestet unter Betriebssystem XP Home und Excel Version XP 2003 SP1.
Bitte keine Mail, Probleme sollten im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.
Betriebssystem Windows 2000 SP4 und Excel Version 2000 SP3..



"Wer Rechtschreibfehler findet, darf sie behalten!"
Anzeige
AW: Drei unabhängige Timer in einem Excelsheet?
28.06.2005 08:23:36
PeterP
Hallo Hajo,
herzlichen Dank, endlich weiß ich jetzt, wie man die Caption von OLE-Objects setzt ;-), da hab ich vor einer Woche entnervt aufgegeben :-D
Hajo: was nun 1 oder 3?
drei, das "einer" bezog sich nur auf die Auflösung
Aber mein Grundproblem kann ich mit Deiner Beispieldatei leider nicht lösen, da dort das Ende ja manuell gesetzt wird. Die Idee mit Startzeit festhalten und Endzeit gegenrechnen hatte ich auch schon verfolgt, ich möchte aber, daß z.B.
eine Viertelstunde lang alle 52, 121 und 63 Sekunden unabhängig voneinander Ereignisse ausgelöst werden (z.B. Subs aufrufen)
d.h. die Zeitdifferenzen zueinander würden nicht konstant bleiben ... und das kriege ich irgendwie nicht hin ...
Das nächste Problem ist, daß die Subs Schleifen sind, welche schon mal 1-2 Sekunden dauern können (Blattbereich in Array einlesen, etwas abarbeiten, Array in Sheet zurückschreiben), wie kriegt man das evtl. entkoppelt - reicht ein DoEvents?
Gruß&Dank
Peter
Anzeige
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
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige