[Συναρτήσεις] Χρονόμετρο στην Excel

[manolis]

Καλησπέρα σε όλη την παρέα.

Φτιάχνω ένα αρχείο για να κάνω κάποιες χρονομετρήσεις.
Χρησιμοποιω την NOW σε κάποια κελιά . Αυτή όμως δείχνει την τρέχουσα ώρα. πχ 1:00:00
Θα ήθελα αν γίνεται να φαίνεται ο χρόνος που κυλάει δηλαδή 1:00:00 , 1:00:01 , 1:00:02 κλπ

Επειδή το PC που θα δουλέψει το αρχείο εχει το 2003 αν είναι δυνατον η απάντηση να είναι για 2003

Σας ευχαριστώ

[manolis]

Αρχική Δημοσίευση από manolis

Καλησπέρα σε όλη την παρέα.

Φτιάχνω ένα αρχείο για να κάνω κάποιες χρονομετρήσεις.
Χρησιμοποιω την NOW σε κάποια κελιά . Αυτή όμως δείχνει την τρέχουσα ώρα. πχ 1:00:00
Θα ήθελα αν γίνεται να φαίνεται ο χρόνος που κυλάει δηλαδή 1:00:00 , 1:00:01 , 1:00:02 κλπ

Επειδή το PC που θα δουλέψει το αρχείο εχει το 2003 αν είναι δυνατον η απάντηση να είναι για 2003

Σας ευχαριστώ

Ψάχνοντας στον θειο γκογκλη βρήκα αυτον τον κώδικα με τον οποίο ξεκινάει το ρολοι.

Αλλα δεν βρίσκω πως να το σταματήσω

Private Sub Workbook_Open()
If Range("A1").Value = "" Then
Range("A2").Value = Time
Range("A2").Interior.ColorIndex = xlNone
Columns("A:A").AutoFit
Reset_Clock
End If
End Sub
Sub Reset_Clock()
Application.OnTime Now() + TimeValue("00:00:01"), "Update_Clock"
End Sub

Sub Update_Clock()
If Range("A2").Interior.ColorIndex = 36 Then
Exit Sub
End If
Range("A2").Value = Range("A2").Value + 1 / 86400
Reset_Clock
End Sub

[Tasos]

Καλημέρα Μανώλη!

Δοκίμασε Το παρακάτω:

Option Explicit

Dim ScheduledTime As Date
Const ScheduledJob As String = "UpdateScreen"

Sub StartTimer()
    ScheduledTime = Now + TimeSerial(0, 0, 1)
    Application.OnTime EarliestTime:=ScheduledTime, _
                       Procedure:=ScheduledJob
End Sub

Sub PauseTimer()
    On Error Resume Next
    Application.OnTime EarliestTime:=ScheduledTime, _
                       Procedure:=ScheduledJob, Schedule:=False
End Sub

Sub ResetTimer()
    PauseTimer
   Sheet1.Range("F1") = TimeSerial(0, 0, 0)
End Sub

Sub UpdateScreen()
    With Sheet1.Range("F1")
        .Value = .Value + TimeSerial(0, 0, 1)
    End With
    StartTimer
End Sub

Φιλικά

Τάσος

[ΤΖΙΜΗΣ]

Τάσο δοκίμασα τον κώδικα και κάθε διαδικασία την έχω αντιστοιχίσει σε κουμπί εντολής.Ένα για την έναρξη, την παύση κτλ.
Όμως τελικά δεν τρέχει.Κάνω κάποιο λάθος;
Φιλικά Τζίμης.

[Tasos]

Καλησπέρα Τζίμη!

Το όνομα Sheet1 θα πρέπει να αντικατασταθεί με το κωδικό όνομα του φύλλου
που θα εμφανίζει το χρονόμετρο (βλ. εικόνα) και πρέπει να το χρησιμοποιούμε στον κώδικα
για να συνεχίσει να τρέχει ακόμα και αν το φύλλο δεν είναι ενεργό (όταν ο χρήστης ενεργοποιήσει άλλο φύλλο ή βιβλίο).



Φιλικά

Τάσος

[manolis]

Γεια σας

Τασο σε ευχαριστώ για τον κώδικα .
Τον έτρεξα και έχω δύο παρατηρησεις-ερωτησεις

1. Οταν ξεκινάει αρχίζει με 12:00:00 και οχι με την τρέχουσα ώρα.

2. Μπορούμε να το εφαρμόσουμε σε παραπάνω απο 2 κελια ?
Γιατί το προσπάθησα αντιγράφοντας τον κώδικα και αλάζοντας το κελί ,αλλα σταμάτησε το ένα και ξεκίνησε το άλλο


Φιλικά
Μανώλης

[ΤΖΙΜΗΣ]

Τάσο ήδη το είχα κάνει αυτό, αλλά τελικά το βρήκα το λάθος.Έπρεπε να εισάγω module και όχι να το εισάγω στο βιβλίο.Τάσο αν μπορείς πες μας λίγα λόγια για την χρησιμότητα της τελευταίας διαδικασίας.(Update Screen) και αν μπορούμε να βάλουμε και ένα όριο, δηλαδή να τερματίζει το ρολόι στα 20 πρώτα λεπτά.
Μανώλη όσο αφορά ότι ξεκινά με 12.00.00 παίζεις με τη μορφοποίηση του κελιού.
Να είστε καλά.

[Tasos]

Μανώλη καλησπέρα!

Ο κώδικας ξεκινά να μετρά από το μηδέν αφού μιλάμε για χρονόμετρο.

Το ότι δείχνει 12:00:00 οφείλεται στη μορφοποίηση του κελιού και χρειάζεται
τροποποίηση (ω:λλ:δδ) σε ελληνική μορφή ημερομηνίας.

Δεν είναι σαφές το ζητούμενο σου.

Να ξεκινά από με την τρέχουσα ώρα και να σταματά που;;
Με τον τρόπο αυτό δεν έχεις χρονόμετρο πια αλλά ρολόι!

Το χρονόμετρο ξεκινά από το μηδέν και μετρά το χρόνο από την έναρξη του μέχρι να το σταματήσει ο χρήστης.

Αυτό που ζητάς είναι μάλλον ο χρόνος που μεσολαβεί από το χρονικό σημείο Α μέχρι το
χρονικό σημείο Β.

Δώσε μας τα φώτα σου

Φιλικά

Τάσος

[Tasos]

Τζίμη έτσι,

Option Explicit

Dim ScheduledTime As Date
Dim EndTime As Date
Const ScheduledJob As String = "UpdateScreen"

Sub StartTimer()
 ' Αν δεν έχει περαστεί τιμή στη μεταβλητή EndTime, (που σημαίνει ότι είναι η πρώτη 
'εκτέλεση του StartTimer() ), τότε θα δοθεί η τιμή Now + TimeSerial(0, 20, 0) 
   If EndTime = 0 Then EndTime = TimeSerial(0, 20, 0)
    ScheduledTime = Now + TimeSerial(0, 0, 1)
    Application.OnTime EarliestTime:=ScheduledTime, _
                       Procedure:=ScheduledJob
End Sub

Sub PauseTimer()
    On Error Resume Next
   'EndTime = 0 '??? Αν θέλεις μηδενίζεις το χρονικό όριο
    Application.OnTime EarliestTime:=ScheduledTime, _
                       Procedure:=ScheduledJob, Schedule:=False
End Sub

Sub ResetTimer()
    PauseTimer
    EndTime = 0
    Sheet1.Range("F1") = TimeSerial(0, 0, 0)
End Sub

Sub UpdateScreen()
    With Sheet1.Range("F1")
        .Value = .Value + TimeSerial(0, 0, 1)  ' Η τιμή του κελιού + 1 δευτερόλεπτο.
        If .Value < EndTime Then StartTimer
    End With
End Sub

Φιλικά

Τάσος

[ΤΖΙΜΗΣ]

Τάσο δε σταματά στο πρώτο εικοσάλεπτο και επιπλέον αν επεξεργάζεσαι κάτι στο φύλλο σταματά ο χρόνος.