Cells(2, 2) = Cells(2, 3) * Fix(datAktuell / Cells(2, 4))
'durch
Cells(2, 2) = Cells(2, 3) * (1 + Fix(datAktuell / Cells(2, 4)))
Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Dim starttime As Long, Wartezeit As Date, jj As Long
Public Sub Start()
starttime = timeGetTime
Cells(2, 2) = 0
Anzeige
End Sub
Public Sub Lap()
Dim laptime As Long
laptime = timeGetTime - starttime
If starttime <> 0 Then MsgBox Long2HMS(laptime), 0, "Zwischenzeit"
End Sub
Public Sub Ende()
Dim stoptime As Long
stoptime = timeGetTime - starttime
If starttime <> 0 Then
Application.OnTime Wartezeit, "Anzeige", , False
Cells(2, 1).ClearContents
MsgBox Long2HMS(stoptime), 0, "so Lea deine Gesamtzeit. Geht das auch schneller?"
End If
starttime = 0
End Sub
Private Sub Anzeige()
Dim displaytime As Long, datAktuell As Date
displaytime = timeGetTime - starttime
Cells(2, 1) = Long2HMS(displaytime)
datAktuell = displaytime / (1000# * 24 * 60 * 60)
If Cells(2, 3) * (1 + Fix(datAktuell / Cells(2, 4))) > Cells(2, 2) Then
If Cells(2, 2) > 0 Then
Beep
MsgBox "neu Punktzahl lautet " & Cells(2, 3) * (1 + Fix(datAktuell / Cells(2, 4)))
End If
Cells(2, 2) = Cells(2, 3) * (1 + Fix(datAktuell / Cells(2, 4)))
End If
Wartezeit = Now + TimeSerial(0, 0, 5)
Application.OnTime Wartezeit, "Anzeige"
End Sub
Private Function Long2HMS(ByVal lngT As Long) As String
Dim hh As Integer, mm As Integer, ss As Double
hh = lngT \ 3600000: lngT = lngT - hh * 3600000
mm = lngT \ 60000: lngT = lngT - mm * 60000
ss = lngT / 1000#
Long2HMS = Format(hh, "00") & ":" & Format(mm, "00") & ":" & Format(ss, "00.000")
End Function
Option Explicit
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Dim starttime As Long, lngTmp As Long, Wartezeit As Date, lngWait As Long
Public Sub Start()
Cells(2, 2) = 0
lngWait = 0
starttime = timeGetTime
Anzeige
End Sub
Public Sub Lap()
If starttime Then
lngTmp = timeGetTime - starttime - lngWait
If lngTmp Then MsgBox Long2HMS(lngTmp), 0, "Zwischenzeit"
End If
End Sub
Public Sub Ende()
If starttime Then
Application.OnTime Wartezeit, "Anzeige", , False
Cells(2, 1).ClearContents
MsgBox Long2HMS(timeGetTime - starttime - lngWait), 0, _
"so Lea deine Gesamtzeit. Geht das auch schneller?"
End If
starttime = 0
lngWait = 0
End Sub
Private Sub Anzeige()
Dim datAktuell As Date, intPkt As Integer
lngTmp = timeGetTime
Cells(2, 1) = Long2HMS(lngTmp - starttime - lngWait)
datAktuell = (lngTmp - starttime - lngWait) / (1000# * 24 * 60 * 60)
intPkt = Cells(2, 3) * (1 + Fix(datAktuell / Cells(2, 4)))
If intPkt > Cells(2, 2) Then
lngWait = lngWait - lngTmp
Cells(2, 2) = intPkt
If Cells(2, 2) > Cells(2, 3) Then Beep: MsgBox "neu Punktzahl lautet " & intPkt
lngWait = lngWait + timeGetTime
End If
Wartezeit = Now + TimeSerial(0, 0, 1)
Application.OnTime Wartezeit, "Anzeige"
End Sub
Private Function Long2HMS(ByVal lngT As Long) As String
Dim hh As Integer, mm As Integer, ss As Double
hh = lngT \ 3600000: lngT = lngT - hh * 3600000
mm = lngT \ 60000: lngT = lngT - mm * 60000
ss = lngT / 1000#
Long2HMS = Format(hh, "00") & ":" & Format(mm, "00") & ":" & Format(ss, "00.000")
End Function