
Originariamente inviata da
teo1964
Ok, errore risolto.
Ti chiedo se puoi un ultimo sforzo: se voglio chiudere il file manualmente (con file/chiudi, prima cioè che la macro sia giunta al termine del countdown), il file in realtà non si chiude ma si ripropone aperto con proseguimento del countdown.
Eh, già, per chiudere anticipatamente il foglio non basta il comando chiudi perché restano i timer attivi che lo riaprono quindi occorre inserire un pulsante apposito per la chiusura anticipata che resetti i timer, salvi e chiuda il foglio.
Sostanzialmente si tratta di ripetere, sul timer lungo, ciò che abbiamo già fatto sul timer breve e inserire un pulsante che richiami la solita Sub Chiudi arricchita della chiusura del timer lungo.
Cominciamo dal pulsante: dalla scheda sviluppo clicca su Inserisci e poi dalla metà inferiore (ActiveX) inserisci un pulsante nel foglio.
La personalizzazione la lascio a te, basta che dal tasto destro scegli proprietà mentre il codice va inserito nel foglio corrispondente al foglio in cui hai inserito il pulsante, comunque basta che ci clicchi spora due volte e finirai già nel foglio giusto in cui inserire la prima parte di codice.
Ti faccio notare solo una cosa: se l'icona Modalità di Progettazione della scheda sviluppo è attiva potrai modificare le proprietà del pulsante col tasto destro e accedere al codice cliccandoci sopra, altrimenti il click eseguirà l'azione associata al pulsante.
L'azione associata al pulsante non è altro che far partire istantaneamente la routine Chiudi, nient'altro.
Purtroppo non sono riuscito a far eseguire una Sub da un ramo all'altro dell'albero dei progetti quindi ho usato l'escamotage della OnTime ma sarebbe stata meglio una semplice chiamata di routine come una call ma non ce l'ho fatta quindi accontentiamoci della OnTime che non sarà elegantissima ma funziona.
Ho modificato anche il codice in Modulo1.
Per prima cosa ho definito la variabile dClose che serve a identificare il timer lungo in modo certo calcolando il momento di chiusura in un solo punto (analoga alla dTime già usata), poi ho spostato il codice che si trovava nella Workbook_Open in una nuova Sub di Modulo1 che ho chiamato Start_Timer in modo che la variabile dClose potesse essere vista anche dalla Chiudi.
Visto che avevo portato l'innesco dei timer nella Modulo1 ho potuto anche utilizzare una variabile unica (la dDurata) per impostare il tempo del countdown invece di doverlo impostare in due punti com'era prima.
La Countdown e la Visualizza non sono cambiate.
La Chiudi invece ha un paio di novità: la prima è che ho aggiunto il reset del timer lungo, identificato dalla dClose e la seconda è che ho dovuto aggiungere le due On Error che hanno lo scopo di disattivare momentaneamente (e riattivare subito dopo) la partenza automatica del debugger in caso di errore perché c'è un caso in cui è corretto che la chiusura del timer dia errore e non voglio che parta il debugger.
Mi spiego meglio.
Se si richiede una chiusura anticipata col pulsante i due timer sono entrambi attivi e quindi possono essere chiusi senza problemi ma se, invece, la chiusura avviene perché il timer principale ha raggiunto la sua ora il reset del ciclo lungo va in errore perché il timer lungo non è più attivo.
In altre parole quella Sub può trovarsi a lavorare con un solo timer attivo o con due quindi occorre disattivare per un attimo il controllo degli errori.
Questo è il nuovo codice, fammi sapere come va:
codice:
In Foglio1
----------
Private Sub CommandButton1_Click()
Application.OnTime Now, "Chiudi"
End Sub
In Modulo1
----------
Dim dTime, dClose, dDurata
Private Sub Start_Timer()
dDurata = "00:10:00"
dClose = Now + TimeValue(dDurata)
Application.OnTime EarliestTime:=dClose, Procedure:="Chiudi"
Application.OnTime Now, "Countdown"
End Sub
Private Sub Countdown()
ThisWorkbook.Sheets(1).[c2] = TimeValue(dDurata)
Visualizza
End Sub
Private Sub Visualizza()
Dim TempoRimanente As Date
TempoRimanente = ThisWorkbook.Sheets(1).[c2]
ThisWorkbook.Sheets(1).[c2] = TempoRimanente - TimeValue("00:00:01")
dTime = Now + TimeValue("00:00:01")
Application.OnTime EarliestTime:=dTime, Procedure:="Visualizza"
End Sub
Private Sub Chiudi()
Application.DisplayAlerts = False
ThisWorkbook.Save
If Application.Workbooks.Count = 1 Then
Application.Quit
Else
On Error Resume Next
Application.OnTime EarliestTime:=dClose, Procedure:="Chiudi", Schedule:=False
On Error GoTo 0
Application.OnTime EarliestTime:=dTime, Procedure:="Visualizza", Schedule:=False
ThisWorkbook.Close
End If
End Sub
In ThisWorkbook
---------------
Private Sub Workbook_Open()
Application.OnTime Now, "Start_Timer"
End Sub