Forum
Σελίδα 1 από 2 1 2
Εμφάνιση 40 μηνυμάτων αυτού του θέματος σε μία σελίδα

Forum (https://www.ms-office.gr/forum/)
-   Excel - Ερωτήσεις / Απαντήσεις (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/)
-   -   [Συναρτήσεις] Χρονόμετρο στην Excel (https://www.ms-office.gr/forum/excel-erotiseis-apantiseis/1062-xronometro-stin-excel.html)

manolis 02-04-11 15:46
Χρονόμετρο στην Excel
 
Καλησπέρα σε όλη την παρέα.

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

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

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

manolis 02-04-11 20:59
Παράθεση:
Αρχική Δημοσίευση από manolis (Μήνυμα 5886)
Καλησπέρα σε όλη την παρέα.

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

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

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

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

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 03-04-11 00:55
Καλημέρα Μανώλη!

Δοκίμασε Το παρακάτω:
Κώδικας:
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
Φιλικά

Τάσος

ΤΖΙΜΗΣ 03-04-11 12:00
Τάσο δοκίμασα τον κώδικα και κάθε διαδικασία την έχω αντιστοιχίσει σε κουμπί εντολής.Ένα για την έναρξη, την παύση κτλ.
Όμως τελικά δεν τρέχει.Κάνω κάποιο λάθος;
Φιλικά Τζίμης.

Tasos 03-04-11 12:34
1 Συνημμένο(α)
Καλησπέρα Τζίμη!

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

Συνημμένο Αρχείο 1361

Φιλικά

Τάσος

manolis 03-04-11 13:04
Γεια σας

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

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

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


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

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

Tasos 03-04-11 14:00
Μανώλη καλησπέρα!

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

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

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

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

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

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

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

Φιλικά

Τάσος

Tasos 03-04-11 14:27
Τζίμη έτσι,

Κώδικας:
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
Φιλικά

Τάσος

ΤΖΙΜΗΣ 03-04-11 15:25
Τάσο δε σταματά στο πρώτο εικοσάλεπτο και επιπλέον αν επεξεργάζεσαι κάτι στο φύλλο σταματά ο χρόνος.


Η ώρα είναι 23:36.
Σελίδα 1 από 2 1 2
Εμφάνιση 40 μηνυμάτων αυτού του θέματος σε μία σελίδα

Ms-Office.gr - ©2000 - 2026, Jelsoft Enterprises Ltd.


Search Engine Optimization by vBSEO 3.3.2