Zeit in hundertstel anpassen aus einer Vorlage

Hallo liebe Experten-Team,
Excel beherrsche ich ziemlich gut, bis auf VBA. Da fehlt mir das absolutes Know-How. Für unseren Sport benötigen wir eine Stoppuhr, welches ich auch fündig wurde. Diese Vorlage ist von http://Hajo-Excel.de/.
Jedoch zählt diese Vorlage nur die Sekunden statt die Hundertstelsekunden (bzw. millisekunden).
Ich habe seit zwei Tagen im Internet durchgeforschtet, aber wenn das Know-How fehlt, suche ich vielleicht nach falschen Begriffen, bzw. bin ich nicht fündig geworden. Auch nach alternativen Vorlagen bin ich nicht wirklich fündig geworden, da die bisherigen gefundenen nicht auf 64-Bit kompaktibel ist...
Ich besitze Excel 2016 auf 64-Bit.
Wer von euch, so hoffe und wünsche ich mir, könnte den Code aus dieser Vorlage entsprechend anpassen, so das der Zähler auch hundertstelsekunden abzählt, statt nur in Sekunden.
Ich bedanke mich im Voraus für die Unterstützung.
Am Rand ist noch zu erwähnen: Diese vorlage kann entsprechend angepasst werden, jedoch sollen die Kommentare, etc. beibehalten werden. Vielen Dank!
https://www.herber.de/bbs/user/123847.xls
Oder ihr schreibt, wie ich es entsprechend anpassen kann!
Vielen herzlichen Dank!
Beste Grüße Steffen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

#If VBA7 Then Private Declare PtrSafe Function getFrequency Lib "kernel32" Alias _ "QueryPerformanceFrequency" (cyFrequency As Currency) As Long Private Declare PtrSafe Function getTickCount Lib "kernel32" Alias _ "QueryPerformanceCounter" (cyTickCount As Currency) As Long #Else Private Declare Function getFrequency Lib "kernel32" Alias _ "QueryPerformanceFrequency" (cyFrequency As Currency) As Long Private Declare Function getTickCount Lib "kernel32" Alias _ "QueryPerformanceCounter" (cyTickCount As Currency) As Long #End If Public Function Microtimer() As Double Dim cyTicks1 As Currency Static cyFrequency As Currency Microtimer = 0 If cyFrequency = 0 Then getFrequency cyFrequency getTickCount cyTicks1 If cyFrequency Then Microtimer = cyTicks1 / cyFrequency End Function

Hi
füge einfach eine Textbox aus den ActiveX-Steuerelementen hinzu (Entwicklertools - Einfügen)
verwende dann diesen Code, um die Stoppuhr über die Tasten
ENTER - Start/Stop
LEER - Zwischenzeit
R - Reset zu steueren.
da ich noch eine kleinigkeit angepasst habe um das ganze sinnvoller steuern zu können, hier nochmal der komplette Code:

Option Explicit
Private dblT As Double
Private bUhrLäuft As Boolean
Private lngR As Long
Private Sub startWatch()
resetWatch
bUhrLäuft = True
dblT = Timer
Me.Shapes("shpStop").Visible = True
Me.Shapes("shpLap").Visible = True
Me.Shapes("shpStart").Visible = False
TextBox1.Activate
On Error Resume Next
Do
DoEvents
Range("D6") = (Timer - dblT) / 86400
DoEvents
Loop While bUhrLäuft
End Sub
Private Sub stopWatch()
bUhrLäuft = False
Rows(10).Insert
Range("B10:D10").Font.ColorIndex = 23
Range("B11:D11").Font.ColorIndex = 15
Range("B10") = "Endtime:"
Range("D10") = Range("D6")
Me.Shapes("shpReset").Visible = True
Me.Shapes("shpStop").Visible = False
Me.Shapes("shpLap").Visible = False
End Sub
Private Sub lap()
lngR = lngR + 1
Rows(10).Insert
Range("B10:D10").Font.ColorIndex = 23
Range("B11:D11").Font.ColorIndex = 15
Range("B10") = "Lap " & Format(lngR, "000") & ":"
Range("D10") = Range("D6")
End Sub
Private Sub resetWatch()
lngR = 0
Range("D6") = 0
With Range("B10:D" & Rows.Count)
.ClearContents
.Font.ColorIndex = 15
End With
Me.Shapes("shpStart").Visible = True
Me.Shapes("shpStop").Visible = False
Me.Shapes("shpLap").Visible = False
Me.Shapes("shpReset").Visible = False
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If bUhrLäuft Then
Select Case KeyCode
Case 13: stopWatch
Case 32: lap
End Select
Else
Select Case KeyCode
Case 13: startWatch
Case Asc("R"): resetWatch
End Select
End If
KeyCode = 0
End Sub

die Tastatursteuerung läuft, sobald sich der Cursor in der Textbox befindet.
dies ist nach dem KLick auf den Startbutton auf jeden Fall gegeben.
Du solltest nach Start der Uhr dann aber auch nicht mehr mit der Maus irgendwohin clicken.
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

Zeit in hundertstel anpassen aus einer Vorlage

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

	A	B	C	D	E	F
1	Gruß Sepp
2
3

Zeit in hundertstel anpassen aus einer Vorlage

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread