Automatisches addieren nach einer bestimmten Zeit

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo
Teil1: habe ich fertig


Sub StartAutosumme()
Autosumme
End Sub


Sub Autosumme()
Dim NextInst As Date
On Error GoTo Fehler
'in A2 soll die Summe stehem
'In B2 soll die Summe stehen.
With ActiveSheet
.Range("A2") = .Range("A2") + .Range("B2")
End With
NextInst = Now + TimeValue("00:00:30")
Application.OnTime NextInst, "Autosumme"
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
If Err.Number  0 Then Resume Next
End Sub


Sub StopAutosumme()
Dim NextInst
On Error Resume Next
Application.OnTime NextInst, "Autosumme", , False
End Sub

muß in eine Standardmodul


Sub StartAutosumme()
Autosumme
End Sub


Sub Autosumme()
Dim NextInst As Date
On Error GoTo Fehler
'in A2 soll die Summe stehem
'In B2 soll die Summe stehen.
With ActiveSheet
.Range("A2") = .Range("A2") + .Range("B2")
End With
NextInst = Now + TimeValue("00:00:30")
Application.OnTime NextInst, "Autosumme"
Fehler:
If Err.Number  0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
If Err.Number  0 Then Resume Next
End Sub


Sub StopAutosumme()
Dim NextInst
On Error Resume Next
Application.OnTime NextInst, "Autosumme", , False
End Sub

Gruß Uwe D

Hallo nochmal
hier nochmal der kompl. Code.
Wichtig ganz oben muß die Declination der Variablen stehen. und nicht im Teilcode selbst.

Option Explicit
Dim NextInst, NextRest
Sub StartAutosumme()
    Autosumme
    Restzeit
End Sub
Sub Autosumme()
    Dim Konstante&
    Konstante = 5
    On Error GoTo Fehler
    'in A2 soll die Summe stehem
    With ActiveSheet
        If .Range("A2") <= 100 Then
            .Range("A2") = .Range("A2") + Konstante
        End If
    End With
    NextInst = Now + TimeValue("00:00:15")
    Application.OnTime NextInst, "Autosumme"
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
    If Err.Number <> 0 Then Resume Next
End Sub
Sub Restzeit()
    Dim TT
    On Error GoTo Fehler
    'in C2 soll die Restzeit stehen
    ActiveSheet.Range("C2") = Format(NextInst - Now, "hh:mm:ss")
    NextRest = Now + TimeValue("00:00:01")
    Application.OnTime NextRest, "Restzeit"
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err.Clear
    If Err.Number <> 0 Then Resume Next
End Sub
Sub StopAutosumme()
    On Error Resume Next
    Application.OnTime NextRest, "Restzeit", , False
    Application.OnTime NextInst, "Autosumme", , False
End Sub

- Gestarter wird über: "StartAutosumme"
- beendet über: "StopAutosumme"
____ dazu kannst du dir ja Buttons anlegen
- Wenn 100 erreicht ist, wird nicht weiteraddiert aber das Makro läuft immer noch weiter
- wenn du nun manuelll in der Zelle die Zahl wieder unter 100 setzt, wird wieder addiert....
Gruß UweD

Beliebteste Forumthreads (12 Monate)

Automatisches addieren nach einer bestimmten Zeit

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Automatisches addieren nach einer bestimmten Zeit

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

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread