Conto alla rovescia in excell 365 per una intera colonna.

[Cesare027]

Ciao a tutti, sono nuovo del forum , forse è una domanda vecchia,avrei bisogno un conto alla rovescia in un intera colonna in ore minuti e secondi con possibilità di vermare la macro e farla ripartire. Grazie mille spero di essermi spiegato bn. Office 365. Non so nulla di vba. Scusatemi. Ciao

[m.paolo]

Spostato nella sezione più adatta: Applicazioni Office Windows

[nikita75]

https://www.youtube.com/watch?v=sbJeGG_Xv8M

se puo' aiutarti

[Anthony47]

... e se non risolvi col video linkato da nikita fatti sentire, spiegando cosa hai gia' fatto e dove ti sei arenato e vedremo di trovare l'inghippo

Ciao

[Cesare027]

Grazie ci provo e ti faccio sapere nei prossimi gg. Grazie

[Cesare027]

Ciao ho provata a seguire il video. Ma cliccando sullo start mi esce "ERRORE DI RUN-TIME 424:
necessario oggetto.
Non capisco dov'è l'errore ho copiato tutto. Io ho office 365. Puo essere quello il problema???

[zsadist]

Se metti un tuo file di esempio, riusciamo a capirti meglio.. così.. è difficile

[Cesare027]

Sub startimer()
Application.OnTime Now + TimeValue("00:00:01"), "nexttick"
End Sub
Sub nexttick()
Sheet1.Range("B1").Value = Sheet1.Range("B1").Value - TimeValue("00:00:01")
startimer
End Sub
Sub stoptimer()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "nexttick", , False
End Sub

[Cesare027]

gia cosi si blocca

[Cesare027]

comunque avrei bisogno di far scorrere le ore minuti e secondi per un intera colonna

[Cesare027]

scusami ma sto cercando di imparare ora il VBA. non so niente...aiutoooo

[Cesare027]

Sub startimer()
Application.OnTime Now + TimeValue("00:00:01"), "nexttick"
End Sub
Sub nexttick()
If sheet1.Range("B1") = 0 Then Exit Sub
sheet1.Range("B1").Value = sheet1.Range("B1").Value - TimeValue("00:00:01")
If sheet1.Range("B1").Value <= TimeValue("00:00:10") Then
sheet1.Shapes("texbox1").Fill.ForeColor.RGB = RGB(255, 0, 0)
Else
sheet1.Shapes("texbox1").Fill.ForeColor.RGB = RGB(255, 255, 255)
End If


startimer
End Sub
Sub stoptimer()
On Error Resume Next
Application.OnTime Now + TimeValue("00:00:01"), "nexttick", , False
End Sub


anche cosi non funziona eppure mi sembra di aver copiato bene………..aiutami quando puoi grazie mille a presto

[Anthony47]

Dovresti pubblicare il file su cui hai fatto le prove; per le istruzioni su come allegare un file:
viewtopic.php?f=26&t=103893&p=605487#p605487

E inoltre dovresti piegare cosa intendi con "comunque avrei bisogno di far scorrere le ore minuti e secondi per un intera colonna"

Ciao

[Cesare027]

Ciao a tutti in un foglio di excell, es colonna H, mi deve scorrere il conto alla rovescia . Es. 680h. Fino a zero e uscire un msgbox. Avendo a disposizione due button, uno di start tempo e uno di stop. Intera colonna perché ci saranno tantissimi conti alla rovescia . Giornalmente si inseriranno ore da attendere la fine. Spero sono stato più chiaro Altrimenti ditemi in cosa non lo sono. Io da solo non sono capace.
Se potete aiutarmi grazie mille

[wallace&gromit]

Prova questi codici
Con un pulsante lanci la sub "avvia", questa scrive in F1 il valore 1 e lancia la sub "aggiorna".
Finché c'è 1 in F1, ogni secondo (ma puoi impostare un intervallo più lungo se vuoi) la sub calcola la differenza tra il tempo di scadenza (che io ho messo in colonna A) e l'ora attuale.
Quando questo passa a sotto 0 esce un messaggio.
La colonna I serve per controllare i messaggi già avviati.
Per interrompere puoi scrivere 0 in F1 o farti un pulsante che lancia la sub "ferma"

Edit il tempo di scadenza deve essere una data completa con giorno mese anno, ora e minuti ev. secondi

Codice: Seleziona tutto

Sub avvia()
Foglio1.Range("F1") = 1
Call aggiorna
End Sub

Sub aggiorna()
Calculate
If Foglio1.Range("F1") = 1 Then
adesso = Now
Application.OnTime Now + TimeValue("00:00:01"), "aggiorna"    'impostato su 1 secondo
UR = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To UR
diff = Range("A" & i) - adesso    ' modificare se le date di confronto non sono in colonna A
If diff < 0 Then
    If Range("I" & i) = "terminato" Then GoTo pross
    Range("H" & i).Clear
    Range("I" & i) = "terminato"
    MsgBox ("conteggio numero: " & i - 1 & " terminato")
Else: Range("I" & i) = "in corso"
Range("H" & i) = diff
Range("H" & i).NumberFormat = "hh:mm;@"
End If
pross:
Next i
End If
End Sub

Sub ferma()
Foglio1.Range("F1") = 0
End Sub


[Cesare027]

grazie sto provando il tuo codice. molto funzionale . domanda si potrebbe in colonna "A" avere delle hh:mm:ss che scorrono a ritroso fino a zero? esempio imposto 12:25:13 e li vedo scorrere fino a zero????? mi puoi aiuatare

Il mio file:
https://we.tl/t-BSLenkZnLy

grazie mille

[Anthony47]

Avresti dovuto pubblicare prima il tuo elaborato, cosi' avremmo capito meglio cosa intendevi
Trovi qui la mia variante: https://www.dropbox.com/s/6xljmciqcwnwd ... .xlsm?dl=0


Per il Countdown ho fatto affidamento sul contenuto di colonna H, che inizialmente tu potrai compilare come preferisci, usando il seguente codice (in sostituzione di quello ora in uso):

Codice: Seleziona tutto

Sub avvia()
If CLng(Foglio1.Range("F1")) = 0 Then
    Foglio1.Range("F1") = Now
    Call Aggiorna
Else
'    Foglio1.Range("F1").ClearContents
End If
End Sub

Private Sub Aggiorna()
Dim cellaT As String, OneS As Double
'
'Debug.Print Timer
If CLng(Foglio1.Range("F1")) <> 0 Then
cellaT = "H"
OneS = TimeSerial(0, 0, 1)
    Application.OnTime Now + TimeValue("00:00:01"), "aggiorna"    'impostato su 1 secondo
    For i = 2 To Foglio1.Cells(Rows.Count, cellaT).End(xlUp).Row
        If Foglio1.Cells(i, cellaT).Value > 0 And CLng(Foglio1.Range("F1")) <> 0 Then
            Foglio1.Cells(i, cellaT).Value = Foglio1.Cells(i, cellaT).Value - OneS
            If Foglio1.Cells(i, cellaT).Value <= 0 Then
                Foglio1.Cells(i, cellaT).Value = 0
            End If
        End If
    Next i
End If
End Sub

Sub ferma()
Foglio1.Range("F1").ClearContents
End Sub


Quando premi Avvia, il countdown parte decrementando il contenuto di colonna H e si sospende quando premi Ferma.

Quanto allo "Stato" in colonna I, lo puoi determinare con questa formula:

Codice: Seleziona tutto

=SE(H2>0;SE($F$1<>"";"In Corso";"SOSPESO");"TERMINATO")


Da inserire in I2 e poi copiare verso il basso.

Ciao

[Cesare027]

Ciao appena riesco provo e ti faccio sapere. Grazieeeee mille. Scusate se non mi ero spiegato bene

[Cesare027]

Ciao non gira la macro mi esce errore: next senza for.....eppure ci sono. Helpppp

[Anthony47]

Devi provare col file che ho pubblicato, che e' quello che avevi pubblicato tu con le modifiche gia' inglobate.

Ciao