CountDown

Question

Ciao a tutti

posto in A1 il valore in ore-minute-secondi (es: 00:00:30), la seguente procedura effettua un countdown:

Dim CountDown As Date

Sub Timer()

CountDown = Now + TimeValue("00:00:01")

Application.OnTime CountDown, "Start"

End Sub

Sub Start()

Dim count As Range

Set count = [A1]

count.Value = count.Value - TimeSerial(0, 0, 1)

If count <= 0 Then

    Call Beep

    Exit Sub

End If

Call Timer

End Sub

Sub Ferma()

Application.OnTime EarliestTime:=CountDown, procedure:="Start", schedule:=False

End Sub

E' possibile modificare il codice affinchè il conteggio continui anche mentre si modificano celle?

Allo stato attuale se scrivo in una cella mentre il contatore è attivo, il conteggio si ferma e riprende al successivo secondo inferiore, non tenendo conto del tempo che ho impiegato per scrivere in una cella.

Grazie

saluti

domenico

Answer 1

Ciao,

ho dimenticato l'ipotesi di "stoppare" il countdown.

Inoltre ho pensato a come azzerare la cella del countdown nel caso la scrittura in altra cella si prolughi oltre la conclusione del countdown.

In un modulo standard ho inserito questo codice:

'---

Option Explicit

Public Const sFoglio As String = "Foglio1"

Public Const sCellaCountDown As String = "A1"

Public rCountDown As Range

Public delay As Double

Public bCountDown As Boolean

Public bStopCountDown As Boolean

Sub StartCountDown()

   Dim CountDown As Double

   Dim Secondo As Double

   Set rCountDown = ThisWorkbook.Worksheets(sFoglio).Range(sCellaCountDown)

   On Error Resume Next

   bCountDown = True

   bStopCountDown = False

   delay = rCountDown * 60 * 60 * 24

   CountDown = Timer + delay

   Secondo = Timer + 1

   Do While Timer < CountDown

      DoEvents

      If Timer > Secondo Then

         Secondo = Timer + 1

         delay = delay - 1

         rCountDown = delay / 60 / 60 / 24

      End If

      If bStopCountDown Then Exit Sub

   Loop

   delay = 0

   rCountDown = 0

   On Error GoTo 0

   Call Beep

End Sub

Sub StopCountDown()

   bStopCountDown = True

   bCountDown = False

   delay = 0

   ' se a seguito dello stop del coutndown _

     si vuole azzerare la cella attivare questa _

     istruzione

   'rCountDown = 0

End Sub

'---

Nel modulo di classe del Foglio1 ho inserito questo codice legato all'evento change:

'---

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

   On Error Resume Next

      Application.EnableEvents = False

      If delay = 0 And bCountDown Then

         rCountDown = 0

         bCountDown = False

      End If

      Application.EnableEvents = True

   On Error GoTo 0

End Sub

'---

Qui puoi trovare un file di esempio:

https://www.dropbox.com/s/l2l797649i84v14/CountDown.xlsm?dl=0

Lascio a te ulteriori test per verificarne il funzionamento :)

Answer 2

Ciao Domenico,

vedo solo ora la tua domanda a cui però ha già dato risposta Norman :)

Answer 3

Ciao Domenico,

Ciao e grazie

mi sfugge  "Timer" ...cos'è? (forse Time?)

(tieni presente che ho excel 2016)

===

Regards,

Norman

Answer 4

Ciao e grazie

mi sfugge  "Timer" ...cos'è? (forse Time?)

(tieni presente che ho excel 2016)

saluti

domenico

Answer 5

Poiché scrivi in una cella non risulta possibile scrivere nella cella del countdown e la procedura si "sospende" fino a che non può riscrivere in quella cella e quindi la procedura continua fino a che non si azzera.

Prova questa procedura, creata al momento, se magari ti può essere da spunto per ulteriori sviluppi:

Sub StartCountDown()

   Dim delay As Double

   Dim CountDown As Double

   Dim Secondo As Double

   On Error Resume Next

   delay = [A1] * 60 * 60 * 24

   CountDown = Timer + delay

   Secondo = Timer + 1

   Do While Timer < CountDown

      DoEvents

      If Timer > Secondo Then

         Secondo = Timer + 1

         delay = delay - 1

         [A1] = delay / 60 / 60 / 24

      End If

   Loop

   [A1] = 0

   On Error GoTo 0

   Call Beep

End Sub

La procedura scrive nella cella il countdown a meno che non si stia scrivendo in un'altra cella.

Ma il countdown continua ad andare avanti e quando si è terminato di scrivere in una cella viene visualizzato il countdown a cui si è arrivati nel frattempo.

Nota però che se tu per scrivere in una cella impiegassi più tempo iniziamente prefissato la procedura arriverebbe fino a fine countdown ma non verrebbe modificata la cella [A1] che non si azzererebbe.