Conto alla rovescia per risposte a quiz di cultura generale.

Question

Buongiorno a tutti gli amici della community.

Ho creato un programmino in Excel (con codice VBA) che mi serve per preparami ad un concorso pubblico che ha prove di cultura generale.

Vorrei simulare con un cronometro il tempo di risposta ad un numero di domande come accade nella realtà, es. impostare un tempo di 60 minuti per rispondere a tot domande.

Allego la schermata della Userform creata che contiene tanti pulsanti con tante funzioni, chiedo il vostro aiuto per poter, basandosi sui tre Option Button chiamati:ARRESTA-RIPRENDI-INIZIA.

In poche parlo quello che vi chiedo gentilmente è questo:

1)al click sull'OPTION Button chiamto INIZIA si deve far partire il tempo ( magari impostato prima in una INPUTBOX oppure a voi il consiglio o la scelta migliore per fare ciò);

2. Al click  sull'OPTION Button chiamto ARRESTA poter bloccare il tempo per poi farlo ripartire al Click  sull'OPTION Button chiamto RIPRENDI.
3. Eventuale possibilità di poter annullare il tutto in qualsiasi momento come se non violessi impostare più il tempo.

Spero di essere stato chiaro e comprensibile, chiedetemi ulteriori dettagli se non sono stato chiaro nell'esposizione della mia esigenza. 

Ciao Nicola.

Answer 1

Ciao Nicola,

Ciao Norman, innanzitutto, come sempre ti ringrazio per la tua disponibilità e professionalità.

Per quanto riguarda questo:

 

Durante il fine settimana, credo che sia a volte necessario di essere più paziente!

chiedo immensamente scusa se vi ho pressato, non volevo produrre questo effetto, vi stimo e vi seguo con molto interesse ed affetto.

Non era affatto mia intenzione di ammonirti  o castigarti! Volevo semplicemente rilevare il fatto che il numero di volontari che aiutano in questa comunità diventa gravemente impoverito tra venerdì sera e lunedi mattina! Di conseguenza, è molto più probabile che le risposte saranno parimenti meno numerose e possono essere soggetti ad un ritardo che sarebbe insolito prima o dopo il fine settimana .

Ti ringrazio per il codice che mi hai postato, cercherò di utilizzarlo ed adattarlo alla mia Userform.

Ti chiedo se sia possibile impostare il tempo da far trascorrere magari in una InputBox ogni volta che parte il tempo per lo svolgimento del quiz senza impostarlo cosi:Public Const iQuizTime As Long = 3600                          '\ 3600 secondi =1 ora  magari consigliando all'utente di imposarlo sempre in secondi, oppure in minuti.

Prova di sostituire il codice precedente nel modulo standard con la seguente versione:

'=========>>

Option Explicit

Public iQuizTime As Long

Public dElapsedTime As Double

Public dStart As Double

Public RunWhen As Double

Public Const cRunWhat = "StopQuiz"

'--------->>

Public Sub Tester()

    Dim Res As Variant

    Dim sPrompt As String, sTitle As String

    Dim iButtons As VbMsgBoxStyle

    Dim bStop As Boolean

    Res = Application.InputBox( _

          Prompt:="inserire il massimo numero di " _

                & "MINUTI per completare il quiz", _

          Title:="QUANTO TEMPO VUOI", _

          Default:=60, _

          Type:=1)

    Select Case Res

    Case "False"

        sPrompt = "Hai cancellato. Riprova!"

        sTitle = "QUANTO TEMPO VUOI"

        iButtons = vbCritical

        bStop = True

    Case Is <= 0

        sPrompt = "Si deve inserire un numero di minuto > 0"

        sTitle = "TEMPO INVALIDO!"

        iButtons = vbCritical

        bStop = True

    Case Is > 0

        iQuizTime = Res * 60

        Nicola.Show vbModeless

    End Select

    If bStop Then

        Call MsgBox(Prompt:=sPrompt, Buttons:=iButtons, Title:=sTitle)

        Exit Sub

    End If

End Sub

'<<=========

'--------->>

Sub StartTimer(dtime As Date)

    RunWhen = Now + dtime

    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _

                       Schedule:=True

End Sub

'--------->>

Public Sub StopTimer()

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _

                       Schedule:=False

End Sub

'--------->>

Public Sub StopQuiz()

    Call MsgBox(Prompt:="Il scelto tempo di " & vbNewLine _

                      & Round(iQuizTime / 60, 2) _

                      & " minuti" & vbNewLine & "è scaduto." _

                      & vbNewLine & "Si sta chiudendo la Userform!", _

                Buttons:=vbInformation, _

                Title:="TERMINA CONCORSO")

    Unload Nicola

End Sub

'<<=========

Nel modulo di codice dell'oggetto Userform, sostituisci il codice precedente con:

'=========>>

Option Explicit

'--------->>

Private Sub UserForm_Initialize()

    dElapsedTime = 0

    With Me

        .cbTempoTrascorso.Enabled = False

        .obArresta.Enabled = False

        .obRiprende.Enabled = False

        .obAnnulla.Enabled = False

    End With

End Sub

'--------->>

Private Sub cbChiudi_Click()

    Unload Me

    Call Shutdown

End Sub

'--------->>

Private Sub TerminaConcorso_Click()

    Dim Res As VbMsgBoxResult

    Res = MsgBox(Prompt:="Hai scelto di porre fine al quiz." _

                       & vbNewLine _

                       & "Se premi Sì, la Userform verrà chiusa!", _

                 Buttons:=vbYesNo, _

                 Title:="TERMINA CONCORSO?")

    If Res = vbYes Then

        Call Shutdown

    End If

End Sub

'--------->>

Private Sub obAnnulla_Click()

    dElapsedTime = 0

    With Me

        cbTempoTrascorso.Enabled = False

        .obInizia.Enabled = False

        .obRiprende.Enabled = False

        .obArresta.Enabled = False

    End With

    Call StopTimer

End Sub

'--------->>

Private Sub obInizia_Click()

    dElapsedTime = 0

    dStart = Now

    Call StartTimer(TimeSerial(0, 0, iQuizTime))

    With Me

        .obInizia.Enabled = False

        .obRiprende.Enabled = False

        .obAnnulla.Enabled = True

        .obArresta.Enabled = True

    End With

End Sub

'--------->>

Private Sub obArresta_Click()

    Call StopTimer

    dElapsedTime = dElapsedTime + Now - dStart

    With Me

        .obRiprende.Enabled = True

        .cbTempoTrascorso.Enabled = True

    End With

End Sub

'--------->>

Private Sub obRiprende_Click()

    Dim iRemainingTime As Date

    iRemainingTime = TimeSerial(0, 0, iQuizTime) - dElapsedTime

    Call MsgBox(Prompt:="Tempo rimanente " _

                      & vbNewLine _

                      & iRemainingTime, _

                Buttons:=vbInformation, _

                Title:="TEMPO RIMANENTE")

    Call StartTimer(iRemainingTime)

    dStart = Now

    Me.cbTempoTrascorso.Enabled = False

End Sub

'--------->>

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    Call Shutdown

End Sub

'--------->>

Private Sub cbTempoTrascorso_Click()

    Call MsgBox(Prompt:=Format(dElapsedTime, "hh:mm:ss"), _

                Buttons:=vbInformation, _

                Title:="Tempo Trascorso")

End Sub

'--------->>

Public Sub Shutdown()

    dElapsedTime = 0

    Call StopTimer

    Unload Me

End Sub

'<<=========

Oltre alla tua ultima richiesta, ho approfittato per effettuare varie altre modifiche minori e miglioramenti al codice suggerito,

Ho caricato il file aggiornato Nicola#3_20150329.xlsm a:  **http://1drv.ms/1F7prDE**

===

Regards,

Norman

Answer 2

Ciao Norman, innanzitutto, come sempre ti ringrazio per la tua disponibilità e professionalità.

Per quanto riguarda questo:

Durante il fine settimana, credo che sia a volte necessario di essere più paziente! 

chiedo immensamente scusa se vi ho pressato, non volevo produrre questo effetto, vi stimo e vi seguo con molto interesse ed affetto.

Ti ringrazio per il codice che mi hai postato, cercherò di utilizzarlo ed adattarlo alla mia Userform.

Ti chiedo se sia possibile impostare il tempo da far trascorrere magari in una InputBox ogni volta che parte il tempo per lo svolgimento del quiz senza impostarlo cosi:Public Const iQuizTime As Long = 3600                          '\ 3600 secondi =1 ora  magari consigliando all'utente di imposarlo sempre in secondi, oppure in minuti.

Auguro Buone Palme a te e ai tuoi cari e ti rinnovo ancora una volta la mia immensa stima.

Ciao Nicola.

Answer 3

Ciao Nicola,

Ho fornito un esempio di come si possa mantenere un conto del tempo in un oggetto UserForm. 

Per fornire la funzionalità rovescia con un limite di tempo pre-stabilito, prova qualcosa del genere:

In un modulo standard, incolla il seguente codice:

 '=========>>

Option Explicit

Public Const iQuizTime As Long = 3600                          '\ 3600 secondi =1 ora

Public dElapsedTime

Public dStart As Double

Public RunWhen As Double

Public Const cRunWhat = "StopQuiz"

'--------->>

Public Sub Tester()

    Nicola.Show vbModeless                                           '<<==== Modifica

End Sub

'<<=========

'--------->>

Sub StartTimer(dtime As Date)

    RunWhen = Now + dtime

    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _

        Schedule:=True

End Sub

'--------->>

Public Sub StopTimer()

    On Error Resume Next

    Application.OnTime EarliestTime:=RunWhen, Procedure:=cRunWhat, _

        Schedule:=False

End Sub

'--------->>

Public Sub StopQuiz()

 Call Nicola.TerminaConcorso_Click

End Sub

'<<=========

Nel modulo della Userform, incolla il seguente codice:

'=========>>

Option Explicit

'--------->>

Private Sub UserForm_Initialize()

    dElapsedTime = 0

    Me.cbTempoTrascorso.Enabled = False

End Sub

'--------->>

Private Sub cbChiudi_Click()

    Unload Me

    Call Shutdown

End Sub

'--------->>

Public Sub TerminaConcorso_Click()

    Dim Res As VbMsgBoxResult

    Res = MsgBox(Prompt:="Sto terminando il concorso!", _

                 Buttons:=vbYesNo, _

                 Title:="TERMINA CONCORSO?")

    If Res = vbYes Then

        Call Shutdown

    End If

End Sub

'--------->>

Private Sub cbAnnulla_Click()

    dElapsedTime = 0

    With Me

        cbTempoTrascorso.Enabled = False

        .obInizia.Enabled = False

        .obRiprende.Enabled = False

        .obArresta.Enabled = False

    End With

    Call StopTimer

End Sub

'--------->>

Private Sub obInizia_Click()

    dElapsedTime = 0

    dStart = Now

    Call StartTimer(TimeSerial(0, 0, iQuizTime))

    With Me

        .obInizia.Enabled = False

        .obRiprende.Enabled = False

    End With

End Sub

'--------->>

Private Sub obArresta_Click()

    Call StopTimer

    dElapsedTime = dElapsedTime + Now - dStart

    Me.obRiprende.Enabled = True

    Me.cbTempoTrascorso.Enabled = True

End Sub

'--------->>

Private Sub obRiprende_Click()

    Dim iRemainingTime As Date

    iRemainingTime = TimeSerial(0, 0, iQuizTime) - dElapsedTime

    Call MsgBox(Prompt:="Tempo rimanente " _

                      & vbNewLine _

                      & iRemainingTime, _

                Buttons:=vbInformation, _

                Title:="TEMPO RIMANENTE")

    Call StartTimer(iRemainingTime)

    dStart = Now

    Me.cbTempoTrascorso.Enabled = False

End Sub

'--------->>

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    Call Shutdown

End Sub

'--------->>

Private Sub cbTempoTrascorso_Click()

    Call MsgBox(Prompt:=Format(dElapsedTime, "hh:mm:ss"), _

                Buttons:=vbInformation, _

                Title:="Tempo Trascorso")

End Sub

'--------->>

Private Sub Shutdown()

    dElapsedTime = 0

    Call StopTimer

    Unload Me

End Sub

'<<=========

Potresti scaricare il mio file di prova Nicola#2_20150329.xlsm a: **http://1drv.ms/1CzuwFd**

===

Regards,

Norman

Answer 4

Ciao Niicola,

Buona sera a tutti, vi chiedo la cortesia di poter riscontrare cortesemente la mia richiestea di aiuto.

Durante il fine settimana, credo che sia a volte necessario di essere più paziente! 

Al fine di dimostrare una possibile soluzione, ho creato una Userform (nominata Nicola) con 4 OptionButton: obInizia, obArresta, obRiprende e obAnnulla. Ho aggiunto due CommandButton: cbChiudi e cbTempoTrascorso.

In un modulo standard, ho incollato il seguente codice:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Nicola.Show vbModeless

End Sub

'<<=========

Nel modulo di codice della Userform, ho incollato il seguente codice:

'=========>>

Option Explicit

Private dElapsedTime As Double

Private dStart As Double

Private dEnd As Double

'--------->>

Private Sub cbChiudi_Click()

    Unload Me

End Sub

'--------->>

Private Sub UserForm_Initialize()

    dElapsedTime = 0

End Sub

'--------->>

Private Sub cbAnnulla_Click()

    dElapsedTime = 0

End Sub

'--------->>

Private Sub obInizia_Click()

    dElapsedTime = 0

    dStart = Now

End Sub

'--------->>

Private Sub cbArresta_Click()

    dElapsedTime = dElapsedTime + Now - dStart

    '    dStart = Now

End Sub

'--------->>

Private Sub obRiprende_Click()

    dStart = Now

End Sub

'--------->>

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)

    dElapsedTime = 0

End Sub

'--------->>

Private Sub cbTempoTrascorso_Click()

    If Me.cbArresta = True Or cbAnnulla = True Then

        MsgBox Format(dElapsedTime, "hh:mm:ss")

    ElseIf dStart = 0 Then

        MsgBox "Per ottenere il tempo trascorso, " _

             & "si deve prima iniziare il cronometro!"

    Else

        MsgBox "Per ottenere il tempo trascorso, " _

             & "si deve prima selezionare l'opzione ARRESTA"

    End If

End Sub

'<<=========

Sul Foglio1 ho aggiunto un pulsante e ho allegato il pulsante alla macro Tester.

Potresti scaricare il mio file di prova Nicola20150329.xlsm a: **http://1drv.ms/19v6T4N**

===

Regards,

Norman

Answer 5

Buona sera a tutti, vi chiedo la cortesia di poter riscontrare cortesemente la mia richiestea di aiuto.

Ho la necessità di risolvere questa esigenza per poter richiedere il vostro aiuto su altre funzioni del programmino.

Ringrazio anticipatamente chi volesse aiutarmi in questo.

Ciao Nicola.