Countdown exel

[ANDREALIMINA]

Buongiorno a tutti,
sono nuovo del forum e ho bisogno di aiuto:
Devo inserire un countdown in exel con un pulsante start pausa.
Vi illustro brevemente a cosa mi serve:
Gestisco un foglio exel per l'evasione di ordini di produzione,se un ordine parte ora e avrà una durata di 3 ore vorrei inserire in exel un countdown che mi determini quanto manca all'evasione dell'ordine.
Se qualcuno mi aiuta mi salverebbe la giornata

Sposto in Applicazioni Office, aurelio37

[Anthony47]

Ciao Andrea, benvenuto nel forum.
Sei stato un po' povero nel descrivere la cosa, quindi mi invento qualcosa io...

Su un foglio del tuo file, segna in colonna C la durata assegnata; usa colonna A e B per altre descrizioni a piacere.
Nella colonna D calcoleremo il tempo accumulato, sulla base di uno "switch" che metteremo in colonna F: 1=Incrementa, <>1 Non Incrementare
Il colonna E puoi calcolare la differenza tra colonna C e colonna D; eventualmente usi la formattazione condizionale per colorare se la cella assume valori inferiori a una soglia a tuo piacere.

Fai questo a partire dalla riga 2, per quante righe ti servono.

Di questo stesso foglio useremo la cella AA1 per scopi di servizio.

A questo punto premi Alt-F11 per accedere all'editor delle macro. Identifica il modulo "Questa Cartella di Lavoro", aprilo e inseriscici questo codice:

Codice: Seleziona tutto

Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Sheets(AA1Sh).Range("AA1") > Now Then
    Application.OnTime Now + TimeValue("00:00:01"), Procedure:="OneSec", schedule:=False
End If
End Sub

Private Sub Workbook_Open()
lastT = Now
Application.OnTime Now + TimeValue("00:00:01"), "OneSec"
End Sub


Per identificare i Moduli delle macro guarda qui: viewtopic.php?f=26&t=103893&p=622593#p622593

Poi inserisci un nuovo Modulo: Menu /Inserisci /Modulo. In questo nuovo Modulo copiaci questo secondo codice:

Codice: Seleziona tutto

Public AA1Sh As String
Public lastT As Double

Sub OneSec()
'
AA1Sh = "Foglio2"          '<<< Il foglio su cui si lavora
'
If ThisWorkbook.Sheets(AA1Sh).Range("AA1") <= Now Then
    lastn = Now
    ThisWorkbook.Sheets(AA1Sh).Range("AA1") = lastT + TimeValue("00:00:01")
    Application.OnTime lastT + TimeValue("00:00:01"), "OneSec"
    Beep
End If
With ThisWorkbook.Sheets(AA1Sh)
    For I = 2 To .Cells(Rows.Count, "C").End(xlUp).Row
        If .Cells(I, "F") = 1 Then .Cells(I, "D") = .Cells(I, "D") + Now - lastT
    Next I
End With
lastT = Now
End Sub


Personalizza la riga marcata <<< col nome del foglio di lavoro su cui hai inserito i progetti e le altre cose.

A questo punto salva il file (deve essere salvato nel formato ".xlsm", macro enabled); chiudilo e riaprilo.

Dovresti sentire ogni secondo un Beep, e per i progetti presenti, la colonna E viene incrementato periodicamente del tempo trascorso, se la colonna F indica 1.
Il conteggio parte all'apertura del file, e si interrompe quando il file si chiude.

Il Beep serve solo per il test; una volta che hai capito come funziona puoi cancellare la relativa istruzione nel Modulo1

Prova e vedi se puo' essere di tuo interesse

[wallace&gromit]

oppure si può provare a percorrere questa via, in A1 ho fissato la data attuale e in B1 la stessa + 3 ore. La C1 è formattata in "hh:mm:ss":

Codice: Seleziona tutto

Sub Countdown()
While Range("B1").Value > Now
    Range("C1") = Range("B1").Value - Now
    DoEvents
Wend
End Sub

potrebbe diventare molto pesante se le cifre da calcolare sono tante.

[Anthony47]

Pero' la Sub Countdown e' una macro che rimane sempre in esecuzione, impedendo praticamente l'utilizzo di quella sessione Excel per altre attivita' (ma se ne puo' sempre aprire un'altra); l'occupazione della cpu e' alta; e manca l'opzione "pausa".

Ciao

[wallace&gromit]

Anthony, non è così drammatica (se ti ricordi qui http://www.pc-facile.com/forum/viewtopic.php?f=26&t=109337&p=641625&hilit=timer#p641625 ti eri ricreduto).
Quando la lancio l'utilizzo della mia CPU passa da un 3% ad un 17% è vero, ma indipendentemente dalla quantità di calcoli che deve fare.
Grazie al DoEvents ho sempre il controllo e si interrompe facilmente anche senza pausa: appena scrivo qualcosa in una cella si interrompe, ma se ne avrò copllegato l'esecuzione ad un pulsante mi basta cliccarlo e riparte regolarmente.
Questa versione mi aggiorna in continuo le righe fino a 100:

Codice: Seleziona tutto

Sub Countdown()
While Range("B1").Value > Now
    For i = 2 To 100
        Cells(i, 3) = Cells(i, 2).Value - Now
    Next i
    DoEvents
Wend
End Sub


[Anthony47]

Eh, non posso mica mettermi a provare tutte le soluzioni...

Comunque, prima di fare danni ad altri file e altri fogli, la tua macro andrebbe modificata in

Codice: Seleziona tutto

Sub Countdown()
While ThisWorkbook.Sheets("IlFoglioDiLavoro").Range("B1").Value > Now
    For i = 2 To 100
        ThisWorkbook.Sheets("IlFoglioDiLavoro").Cells(i, 3) = ThisWorkbook.Sheets("IlFoglioDiLavoro").Cells(i, 2).Value - Now
    Next i
    DoEvents
Wend
End Sub


Ciao