Office: (Office 2007) Eine Art Stoppuhr

Chemy · 3. Oktober 2009

Hallo!

Ich möchte folgenge Funktion in Excel erstellen:
Bei Drücken auf die Enter-Taste soll eine Stoppuhr gekoppelt an die Systemzeit beginnen, bei erneutem Drücken soll sie stehen bleiben. Ich möchte die Anfangs- und die Endzeit sowie die Laufdauer der Stoppuhr angezeigt bekommen. Und das soll auch für mehrere Parameter gleichzeitig geschehen. Also ich möchte die Laufzeit von Parameter 1 zeitversetzt von Parameter 2 starten können und auch wieder beenden.
Kann mit jemand erklären, wie ich dies in Excel realisieren kann oder ob soetwas überhaupt möglich ist?

Viele Grüße!

:)

chris-kaiser · 5. Oktober 2009

hiho

das hier hätte ich gefunden
Online - Excel Programmierung VBA Makro: Stoppuhr in Excel

Code:

Stoppuhr in Excel

Sie wollen einen Wettkampf stoppen, ihre Videos schneiden, oder was auch immer, und müssen dazu Zeiten, Millisekunden genau, in eine Tabelle eintragen. Kein Problem. Mit folgendem Code generieren sie eine eigene Symbolleiste, welche einer komfortablen Stoppuhr entspricht.

Die Funktion der Buttons:

· Start - Startet die Zeitmessung
· Stop - Beendet die Zeitmessung und gibt die gestoppte Zeit in der aktiven Zelle aus
· Pause - Unterbricht die Zeitmessung
· Lap - Gibt die Zwischenzeit in der aktiven Zelle aus
· Reset - Uhr zurücksetzen
· Preset - Zeit vorgeben, ab der die Zeitmessung beginnen soll

Die Zwischenzeit (Lap), kann auch mit der Tastenkombination Strg+y in die aktive, oder einem Doppelklick in eine beliebige Zelle, ausgegeben werden. Der Cursor spring, nach der Ausgabe der Zeit, automatisch eine Zelle nach unten.

Die benötigten Makros werden in drei Modulen untergebracht. Im Klassenmodul DieseArbeitsmappe" befinden sich die Ereignisroutinen zum anlegen und löschen der Symbolleiste. Ein Standardmodul mit Namen basCommandbar", in dem die Symbolleiste angelegt wird, sowie ein Standardmodul mit dem Namen basClock", welches die Steuerung der Stoppuhr übernimmt.

' **************************************************************
' Modul: DieseArbeitsmappe Typ = Element der Mappe(Sheet, Workbook, ...)
' **************************************************************

Option Explicit

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
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Chemy · 5. Oktober 2009

Hallo!

Danke für die schnelle Antwort! So ungefähr hab ich mir das vorgestellt. Nur leider weiß ich nicht, wo ich die Befehle eingeben muss. Ich habe von programmieren nicht so viel Ahnung. Kann man diese Uhr auch an die Systemzeit koppeln? Das wäre extrem wichtig! Und ich brauche unbedingt die Start- und Endzeiten in der Tabelle...

Vielleicht kannst du/können Sie mir da auch weiterhelfen?!
Viele Grüße!

chris-kaiser · 5. Oktober 2009

hiho

wenn du beschreibst was du genau brauchst..
wo soll die startzeit(endzeit) stehen
was soll zeitmäßig erfast werden
wann soll das starten

Chemy · 5. Oktober 2009

Huhu!

Ich brauche eine Tabelle, in der Flugzeiten erfasst werden. Dabei soll ein Pilot ausgewählt werden und die Startzeit mit Klick auf einen Button oder mit Drücken von Enter gestartet werden. Die Starzeit soll dann in einer Spalte neben dem Pilotennamen angezeigt werden und im Hintergrund soll eine Stoppuhr mitlaufen. Wenn der Pilot nun landet, dann soll wieder mit nem Button oder mit Enter die im Hintergrund laufende Zeit angehalten werden und die Landezeit wiederum in einer eigenen Spalte angezeigt werden. Ich brauche also quasi eine Tabelle, in der in drei Spalten der Pilotenname und die zugehörige Start- und Landezeit eingetragen werden.
Wenn ein anderer Pilot startet, während der erste noch in der Luft ist, darf die Zeit des ersten Piloten aber nicht angehalten werden. Es müssen also mehrere Zeiterfassungen nebeneinander stattfinden können.
Und das ganze möglichst noch Idiotensicher . Funktioniert das mit Excel?

Liebe Grüße und schonmal vielen Dank für die Mühe!!

EarlFred · 5. Oktober 2009

Hallo Chemy,

dafür brauchst Du aber m. E. keine "Stoppuhr", sondern musst nur die Differenz zwischen Lande- und Startzeit berechnen.

Hierzu eine ganz einfache Überlegung: Wenn in einer Zelle ein "x" eingetragen wird, wird das "x" per Makro mit der aktuellen Systemzeit überschrieben.

Code im Klassenmodul des betreffenden Tabellenblattes:
Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count = 1 Then
If Target.Value = "x" Then
Application.EnableEvents = False
Target = Time
Application.EnableEvents = True
End If
End If
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Sobald ein Pilot startet oder landet, einfach in der betreffenden Zelle ein "x" eintragen. In der Spalte hinter den Zeiten für Starts und Landungen einfach die Differenz bilden:
Code:

=(C2-B2)*(C2>B2)
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Die Zellen ggf. noch in das gewünschte Format bringen.

Dann kannst Du beliebig viele Piloten parallel in der Luft haben, das ist egal.

Grüße
EarlFred

Chemy · 5. Oktober 2009

Hallo!

Ja, so hab ich mir das gedacht. Aber wo muss ich den oberen Code eingeben? Die Diffenzenzbildung muss ja nur in das Funktionsfeld F(x). Kann man statt eines X auch einen Button mit der Systemzeit verknüpfen?

Danke für deine Hilfe und LG

chris-kaiser · 5. Oktober 2009

hiho

hier ein Pilotversuch *Smilie

EarlFred · 5. Oktober 2009

- hat sich erledigt *wink.gif* -

Chemy · 5. Oktober 2009

Hallo ihr beiden!

Wow! Genauso hab ich mir das vorgestellt! *Smilie Vielen, vielen DANK!

Aber: könnt ihr mir trotzdem verraten, wie ihr das hinbekommen habt? Ich bräuchte die Funktion nämlich für mehr Piloten. Leider konnte ich die Button und Felder nicht kopieren... Toll wäre, wenn man daraus eine unendliche Tabelle machen könnte.

Ganz liebe Grüße
*bye

EarlFred · 5. Oktober 2009

Hallo Chemy,

für den Fall, dass es nach Chris' anschaulichem Beispiel noch von Nutzen ist: Der Code kommt in das betreffende Arbeitsblatt:

Z. B. Rechtsklick auf den Tabellenblattreiter, dort "Code anzeigen" wählen und dann im daraufhin aufgehenden Fenster eintragen.

Grüße
EarlFred

Chemy · 5. Oktober 2009

Hey,

tut mir leid, ich kann es nicht selbt erstellen. Ich hab den Code einfach kopiert, bekomme aber die Button nicht hin.
Ich gebe auf und nutze die Vorlage von Chris, wenn ihr mir verratet, wie ich mehr Piloten und mehr Buttons hinbekomme. Kopieren funktioniert leider nicht. *frown.gif*

Die langsam verzweifelnde Chemy

Chemy · 5. Oktober 2009

Hey ihr zwei,

ich nehme alles zurück und behaupte das Gegenteil! Ich habs nu doch geschafft. Nochmal ganz herzlichen Dank für die tolle Hilfe!
Weiter so!
Chemy

Office: (Office 2007) Eine Art Stoppuhr

Eine Art Stoppuhr

Eine Art Stoppuhr

Eine Art Stoppuhr

Eine Art Stoppuhr

Eine Art Stoppuhr

Eine Art Stoppuhr - Similar Threads - Art Stoppuhr

Spalte mit Art. Nr. durchsuchen und bei Treffer diese Art. Nr. in die Nachbarspalte ausgeben

Beliebige Arten von Dateien auslesen und umbenennen

Symbole: eine neue Art von Office-ClipArt

Ändern der Farbe, Art oder Stärke einer Linie

Auswertung Art "Equalizer" im Formular

Ist es Möglich für Lehrer eine Art Stundenplan für Online Kurse einzurichten ?

Word 2016: Ganz normalen Text spiegeln (ohne Word Art)