Θέμα: Συναρτήσεις Χρονόμετρο στην Excel

Εμφάνιση ενός μόνο μηνύματος
  #9  
Παλιά 03-04-11, 14:27
Το avatar του χρήστη Tasos
Tasos Ο χρήστης Tasos δεν είναι συνδεδεμένος
Διαχειριστής
Όνομα: Τάσος Φιλοξενιδης
Έκδοση λογισμικού Office: Ms-Office 365
Γλώσσα λογισμικού Office: Ελληνική, Αγγλική, Γερμανική
 
Εγγραφή: 21-10-2009
Μηνύματα: 2.035
Προεπιλογή

Τζίμη έτσι,

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

Τάσος
__________________
Ms-Office Development Team
Ανάπτυξη επαγγελματικών εφαρμογών

Τελευταία επεξεργασία από το χρήστη Tasos : 03-04-11 στις 16:03.
Απάντηση με παράθεση