Stoppuhr

Private Sub Workbook_Activate()
Call prc_CreateCommandBar
End Sub

Private Sub Workbook_Deactivate()
Call prc_DeleteCommandBar
End Sub

' **************************************************************
' Modul: basCommandbar Typ = Allgemeines Modul
' **************************************************************
Option Explicit
Option Private Module
' Code Max Kaffl 2005
Public objCommandBar As CommandBar
Public objCommandBarButton(6) As CommandBarButton

Public Sub prc_CreateCommandBar()
Call prc_DeleteCommandBar
Set objCommandBar = CommandBars.Add(Name:="Stoppuhr", _
Position:=msoBarFloating, Temporary:=True)
Call prcControlAdd(objCommandBar, _
varControl:=objCommandBarButton(0), _
enumType:=msoControlButton, varOnAction:="prc_Start", _
varCaption:="Start", enumStyle:=msoButtonCaption, _
varTipText:="starten")
Call prcControlAdd(objCommandBar, _
varControl:=objCommandBarButton(1), _
enumType:=msoControlButton, varOnAction:="prc_Stop", _
varCaption:="Stop", enumStyle:=msoButtonCaption, _
bolEnabled:=False, varTipText:="stoppen")
Call prcControlAdd(objCommandBar, _
varControl:=objCommandBarButton(2), _
enumType:=msoControlButton, varOnAction:="prc_Pause", _
varCaption:="Pause", enumStyle:=msoButtonCaption, _
bolEnabled:=False, varTipText:="anhalten")
Call prcControlAdd(objCommandBar, _
varControl:=objCommandBarButton(3), _
enumType:=msoControlButton, varOnAction:="prc_Lap", _
varCaption:="Lap", enumStyle:=msoButtonCaption, _
bolEnabled:=False, varTipText:="Zwischenzeit")
Call prcControlAdd(objCommandBar, _
varControl:=objCommandBarButton(4), _
enumType:=msoControlButton, varOnAction:="prc_Reset", _
varCaption:="Reset", enumStyle:=msoButtonCaption, _
bolEnabled:=False, varTipText:="zurücksetzen")
Call prcControlAdd(objCommandBar, _
varControl:=objCommandBarButton(5), bolBeginGroup:=True, _
enumType:=msoControlButton, varTipText:="Anzeige", _
varCaption:="00:00:00,000", enumStyle:=msoButtonCaption)
Call prcControlAdd(objCommandBar, _
varControl:=objCommandBarButton(6), bolBeginGroup:=True, _
enumType:=msoControlButton, varOnAction:="prc_Preset", _
varCaption:="Preset", enumStyle:=msoButtonCaption, _
varTipText:="Voreinstellung")
With objCommandBar
.Top = 150
.Left = 100
.Protection = msoBarNoChangeDock + msoBarNoChangeVisible _
+ msoBarNoCustomize + msoBarNoHorizontalDock _
+ msoBarNoResize + msoBarNoVerticalDock
.Visible = True
End With
End Sub

Public Sub prc_DeleteCommandBar()
On Error Resume Next
KillTimer lnghWnd, 0
CommandBars("Stoppuhr").Delete
End Sub

Private Sub prcControlAdd( _
ByRef objParent As Object, _
Optional ByRef varControl As Variant, _
Optional ByVal enumType As MsoControlType, _
Optional ByVal varId As Variant, _
Optional ByVal varBefore As Variant, _
Optional ByVal varTemporary As Variant, _
Optional ByVal bolBeginGroup As Boolean = False, _
Optional ByVal varCaption As Variant, _
Optional ByVal varFaceId As Variant, _
Optional ByVal varOnAction As Variant, _
Optional ByVal enumStyle As MsoButtonStyle, _
Optional ByVal varTipText As Variant, _
Optional ByVal enumState As MsoButtonState, _
Optional ByVal varTag As Variant, _
Optional ByVal enumLinkType As MsoCommandBarButtonHyperlinkType, _
Optional ByVal bolEnabled As Boolean = True, _
Optional ByVal bolVisible As Boolean = True, _
Optional ByVal varWidth As Variant, _
Optional ByVal varDropDownWidth As Variant, _
Optional ByVal varDropDownLines As Variant)
Dim cmbControl As CommandBarControl
Select Case IIf(enumType, 1, 0) & IIf(IsMissing(varId), 0, 1) & _
IIf(IsMissing(varBefore), 0, 1) & IIf(IsMissing(varTemporary), 0, 1)
Case "0100": Set cmbControl = objParent.Controls.Add(ID:=varId)
Case "0101": Set cmbControl = objParent.Controls.Add(ID:=varId, _
Temporary:=varTemporary)
Case "0110": Set cmbControl = objParent.Controls.Add(ID:=varId, _
Before:=varBefore)
Case "0111": Set cmbControl = objParent.Controls.Add(ID:=varId, _
Before:=varBefore, Temporary:=varTemporary)
Case "1000": Set cmbControl = objParent.Controls.Add(Type:=enumType)
Case "1001": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
Temporary:=varTemporary)
Case "1010": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
Before:=varBefore)
Case "1011": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
Before:=varBefore, Temporary:=varTemporary)
Case "1100": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
ID:=varId)
Case "1101": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
ID:=varId, Temporary:=varTemporary)
Case "1110": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
ID:=varId, Before:=varBefore)
Case "1111": Set cmbControl = objParent.Controls.Add(Type:=enumType, _
ID:=varId, Before:=varBefore, Temporary:=varTemporary)
End Select
With cmbControl
.BeginGroup = bolBeginGroup
If Not IsMissing(varCaption) Then .Caption = varCaption
If Not IsMissing(varFaceId) Then .FaceId = varFaceId
If Not IsMissing(varOnAction) Then .OnAction = varOnAction
If enumStyle Then .Style = enumStyle
If Not IsMissing(varTipText) Then .TooltipText = varTipText
If enumState Then .State = enumState
If Not IsMissing(varTag) Then .Tag = varTag
If enumLinkType Then .HyperlinkType = enumLinkType
.Enabled = bolEnabled
.Visible = bolVisible
If Not IsMissing(varWidth) Then .Width = varWidth
If Not IsMissing(varDropDownWidth) Then _
.DropDownWidth = varDropDownWidth
If Not IsMissing(varDropDownLines) Then _
.DropDownLines = varDropDownLines
End With
If Not IsMissing(varControl) Then Set varControl = cmbControl
Set cmbControl = Nothing
End Sub

' **************************************************************
' Modul: basClock Typ = Allgemeines Modul
' **************************************************************
Option Explicit
Option Private Module
' Code Max Kaffl 2005
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function SetTimer Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long
Public lnghWnd As Long
Private lngStartTime As Long, lngPauseTime As Long
Private lngPresetTime As Long
Private blnPause As Boolean

Private Sub prc_Start()
Dim intIndex As Integer
lngStartTime = timeGetTime - lngPresetTime
With Application
.MacroOptions Macro:="prc_Lap", _
HasShortcutKey:=True, ShortcutKey:="y"
.OnDoubleClick = "prc_Lap"
End With
blnPause = False
lngPresetTime = 0
objCommandBarButton(0).Enabled = False
For intIndex = 1 To 4
objCommandBarButton(intIndex).Enabled = True
Next
objCommandBarButton(6).Enabled = False
lnghWnd = FindWindow("XLMAIN", Application.Caption)
SetTimer lnghWnd, 0, 1, AddressOf prc_Display
End Sub

Public Sub prc_Lap()
ActiveCell.Value = fnc_strTime(timeGetTime - lngStartTime)
ActiveCell.Offset(1, 0).Select
End Sub

Private Sub prc_Pause()
If blnPause Then
lngStartTime = lngStartTime + (timeGetTime - lngPauseTime)
objCommandBarButton(3).Enabled = True
SetTimer lnghWnd, 0, 1, AddressOf prc_Display
Else
lngPauseTime = timeGetTime
objCommandBarButton(3).Enabled = False
KillTimer lnghWnd, 0
objCommandBarButton(5).Caption = fnc_strTime(timeGetTime - lngStartTime)
End If
blnPause = Not blnPause
End Sub

Private Sub prc_Stop()
Dim intIndex As Integer
If blnPause Then _
lngStartTime = lngStartTime + (timeGetTime - lngPauseTime)
ActiveCell.Value = fnc_strTime(timeGetTime - lngStartTime)
KillTimer lnghWnd, 0
For intIndex = 1 To 3
objCommandBarButton(intIndex).Enabled = False
Next
objCommandBarButton(5).Caption = ActiveCell.Text
ActiveCell.Offset(1, 0).Select
End Sub

Private Sub prc_Reset()
Dim intIndex As Integer
KillTimer lnghWnd, 0
lngStartTime = 0
objCommandBarButton(0).Enabled = True
For intIndex = 1 To 4
objCommandBarButton(intIndex).Enabled = False
Next
objCommandBarButton(5).Caption = "00:00:00,000"
objCommandBarButton(6).Enabled = True
With Application
.MacroOptions Macro:="prc_Lap", _
HasShortcutKey:=True, ShortcutKey:=""
.OnDoubleClick = ""
End With
End Sub

Private Sub prc_Preset()
Dim vntInput As Variant
Do
vntInput = InputBox("Vorgebezeit im Format hh:mm:ss eingeben.", _
"Eingabe", "00:00:00")
If StrPtr(vntInput) = 0 Then Exit Sub
If vntInput Like "##:##:##" And IsDate(vntInput) Then Exit Do
MsgBox "Fehlerhafte Eingabe.", 48, "Hinweis"
Loop
lngPresetTime = CDbl(CDate(vntInput)) * 86400000
objCommandBarButton(5).Caption = fnc_strTime(lngPresetTime)
End Sub

Private Sub prc_Display(ByVal hwnd As Long, ByVal nIDEvent As Long, _
ByVal uElapse As Long, ByVal lpTimerFunc As Long)
objCommandBarButton(5).Caption = fnc_strTime(timeGetTime - lngStartTime)
End Sub

Private Function fnc_strTime(ByVal lngTime As Long) As String
Dim lngHour As Long, lngMinute As Long, lngSecond As Long
lngHour = lngTime \ 3600000
lngMinute = (lngTime Mod 3600000) \ 60000
lngSecond = (lngTime Mod 3600000 Mod 60000) \ 1000
lngTime = lngTime Mod 3600000 Mod 60000 Mod 1000
fnc_strTime = Format(CStr(lngHour), "00") & ":" & _
Format(CStr(lngMinute), "00") & ":" & _
Format(CStr(lngSecond), "00") & "," & _
Format(CStr(lngTime), "000")
End Function

Nun würde ich gerne, dass die Menüleiste nicht als Popup, sondern gedockt in der Menüleiste erscheint. Weiterhin wäre es super, wenn ich die laufende Zeit live in einem gesonderten Textfeld, einer Zelle, Userform etc. auslesen könnte, um sie größer darzustellen.
Ich bin für jede Hilfe dankbar!!!
Gruß Frank