Zähler mit Sekundentaktung

Hallo Ihr Lieben,

hab da ein Problem. Und zwar versuche ich einen Zähler zu programmieren
der nach 5 Sekunden immer eins hochzählt.
Habe das in VB sehr schnell hinbekommen, jedoch ist das in VBA nicht so einfach,
da die Timer funktion fehlt.
Habe es soweit das die Systemzeit ausgegeben wird. Diese soll in einem anderen
Textfeld laufen.
Kann mir da von euch jemand weiterhelfen?

Mein VB-Code:

Option Explicit

Private nSek As Integer


Private Sub Form_Load()
' Timer Werte zuweisen
Timer1.Interval = 6000
'Zähler
nSek = 0
'Ausgabe in Bezeichnungsfeld
Label1.Caption = CStr(nSek)
End Sub


Private Sub Timer1_Timer()
' und wieder eine Sekunde vorbei
nSek = nSek + 1
Label1.Caption = CStr(nSek)
' Falls 10 Sekunden erreicht, Timer deaktivieren
If nSek >= 10 Then Timer1.Enabled = False
End Sub

Mein vorläufiger VBA-Code:


Private Sub UserForm_Layout()
Call Scroll_Text
End Sub


Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Stopped = 1
End Sub


Private Sub Scroll_Text()
Stopped = 0
Do
TextBox1 = Time
Call Pause(100, 1)  'Tempo des Wechsel
Loop Until Stopped = 1
End Sub


Private Sub Pause(ByVal Pau As Single, ByVal DoEv As Integer)
Call Sleep(Pau)
If DoEv = 1 Then DoEvents
End Sub


Private Sub CommandButton1_Click()
If Stopped = 1 Then
Stopped = 0
CommandButton1.Caption = "Stop"
Call Scroll_Text
Else
Stopped = 1
CommandButton1.Caption = "Start"
End If
End Sub

Danke schonmal im Voraus.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Schließen ausgeführt. Kannst ja für dich abändern. Gruß Thomas Sub startzeit() On Error Resume Next Application.OnTime EarliestTime:=DatA, Procedure:="Schließen", Schedule:=False DatA = Time + CDate("0:05:00") Application.OnTime DatA, "Schließen" End Sub

Private Sub Timer1_Timer() ' und wieder eine Sekunde vorbei nSek = nSek + 1 Label1.Caption = CStr(nSek) ' Falls 10 Sekunden erreicht, Timer deaktivieren If nSek >= 10 Then Timer1.Enabled = False End Sub

Hallo Moni,
folgende Variante erhöht in der beim macrostart aktiven zelle alle 5 sekunden den Wert um 1, wenn du anstatt timecell.value den wert txtbox.caption wählst sollte das macro auch bei dir laufen.(etwas feintuning vorausgesetzt ;-))

Private c As Boolean, timezell As Range


Sub zeit_starten()
ActiveCell.Activate
If Selection.Value <> "" Then
MsgBox ("Achtung! die Zelle ist nicht leer")
Else
Set timezell = Application.Selection
ZeitFestLegen1
c = True
End If
End Sub


Sub ZeitFestLegen1()
Zeitangabe = Time + TimeSerial(0, 0, 5)
Application.OnTime Zeitangabe, "eintragen1"
End Sub


Sub eintragen1()
timezell.Value = timezell.Value + 1
If c = True Then ZeitFestLegen1
End Sub

'Damit kann die Ausführung abgebrochen werden:


Sub notstopp()
c = False
End Sub

Ich hoffe, das hilft Dir weiter

Gruß Ingo

Beliebteste Forumthreads (12 Monate)

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread