Un Quiz con Wait e Timer
A completamento dell'articolo "Azioni a tempo con ..." concludiamo con un altro piccolo esempio anch'esso basato sulle temporizzazioni.
Uso combinato di Wait ed Timer per un Quiz
Come ultimo esempio ho preparato, con il supporto di Ennius che certo la sa più lunga di me, un semplice giochino, un Quiz certamente migliorabile o adattabile alle nostre esigenze personali.
Ma prima di passare al codice occorre compiere alcune azioni preliminari necessarie al funzionamento del programma.
In un foglio di Excel (io ho usato il Foglio 3) scrivo le domande da proporre nei quiz e le relative risposte.
Sul foglio principale (il Foglio 2) useremo lo schema sottostante.
Il riquadro che nella figura sottostante appare Grigio è un normale pulsante preso dalla barra Moduli a cui è abbinata la routine di partenza. Il resto rappresenta le celle del foglio opportunamente colorate e formattate secondo il nostro personale gusto estetico (il mio forse lascia un pò a desiderare)
|
 |
Fatto questo si va nell'editor del VBA e si disegna una UserForm come questa
(l'immagine
disegnata dentro è opzionale)
Compiute queste operazioni preliminari si passa alla progettazione e scrittura del codice.
L'azione parte quando facciamo click sul pulsante "Il Quiz" disegnato sul foglio. Ci viene prima mostrato un messaggio e poi la domanda a cui dovremo rispondere.
In un Modulo Standard scriveremo questa routine dopo aver dichiarato come pubblica la variabile Pausa perchè usata in più routines:
Public Pausa
Sub Quiz2()
Dim OraAttuale
Dim Uriga, RCaso
' evito il continuo
inutile ricorso alla Worksheet_Change
Application.EnableEvents = False
Range("G1") = ""
Range("D10") = ""
Range("D14") = ""
Range("D17") = ""
Range("D18") = ""
Range("D19") = ""
Application.EnableEvents = True
UserForm3.Show 'viene
mostrata per circa 3 secondi
Randomize
'mi preparo a generare
i numeri casuali
Uriga = Sheets("Foglio3").Range("A1").End(xlDown).Row
'scelgo a caso una
delle righe in cui sono scritte le domande
RCaso = Int((Uriga *
Rnd) + 1)
'nascondo il pulsante
per evitare un secondo click su di esso
Worksheets("Foglio2").Shapes(4).Visible
= msoFalse
Range("G1") = RCaso
Range("D10") = Sheets("Foglio3").Cells(RCaso, 1)
Range("D18") = Time
Range("D14").Select
'viene impostata ed
attivata la temporizzazione
Pausa = 10
OraAttuale = Timer
Do While Timer < OraAttuale + Pausa
DoEvents
Loop
SendKeys "{ENTER}"
'questo merita un commento
a parte
If Range("D17") = "" Then
Range("D14") = Range("D15")
Range("D15") = ""
End If
Worksheets("Foglio2").Shapes(4).Visible = msoTrue
Risposta
End Sub
|
Nota per SendKeys "{ENTER}": questa istruzione serve per simulare la pressione del tasto Enter da tastiera. Si è ritenuta necessaria questa istruzione perchè, se allo scadere del tempo il cursore si trova ancora nella cella di inserimento, occorrerebbe premere manualmente tale tasto e la cosa in questo contesto non sarebbe accettabile. Tuttavia un effetto collaterale di SendKeys "{ENTER}" è che provoca lo spostamento di quanto è contenuto nella cella di origine in quella sottostante.
Range("D14") = Range("D15") |
e dopo
SendKeys "{ENTER}" si otterrà
per cui si
rendono necessarie le successive istruzioni
In teoria la temporizzazione impostata in questa routine (le istruzioni evidenziate in grassetto) serve solo se, dopo la visualizzazione della domanda posta nella cella D10, non si fornisce la risposta nel tempo utile (il cursore è ancora nella cella attiva perchè si sta continuando a scrivere) o se non si da affatto la risposta. Infatti data la risposta e premendo il tasto Enter per conferma entro il tempo impostato, viene scatenato l'evento Worksheet_Change del foglio e vanifica questa temporizzazione.
Alla seguente routine, scritta nello stesso modulo di quella precedente, si deve tuttavia poter accedere in entrambi i casi appena visti e per questo all'inizio occorre porsi in condizione di non eseguirla una seconda volta se è stata già visitata. Non commento il codice seguente in quanto non comprende strutture particolari e quelle contenute possono tranquillamente essere modificate secondo le proprie necessità. Una unica osservazione, per i motivi che ho appena accennati, è che, siccome vi si accede quando viene scatenato l'evento Worksheet_Change e dalla routine qui sopra descritta, per impedire il continuo ripetersi delle istruzioni in essa contenute, io ho imposto di controllare la cella D17 dove scrivo uno dei messaggi adatti alle varie situazioni in cui ci si viene a trovare dopo la risposta.
Vedi le righe di istruzioni evidenziate.
Sub Risposta()
Dim RCaso, A
Dim LaRisposta
If Range("D17") <> "" Then Exit Sub
Application.EnableEvents = False
Range("D19") = Second(Time - Range("D18"))
RCaso = Range("G1")
LaRisposta = Range("D14")
If Not IsNumeric(LaRisposta) Then
LaRisposta = "*" & LCase(LaRisposta)
End If
Select Case LCase(Sheets("Foglio3").Cells(RCaso, 2)) Like LaRisposta
Case True
Range("D17") = "Bene"
Case False
If Range("D14") = "" Then
Range("D17")
= "Tempo scaduto"
Else
Range("D17")
= "Risposta sbagliata"
End If
End Select
Application.EnableEvents = True
Worksheets("Foglio2").Shapes(4).Visible = msoTrue
End Sub
Fatto questo, che è il lavoro più impegnativo, passiamo a scrivere nel modulo nella nostra UserForm, che ci serve per avvisarci della prossima domanda il seguente codice:
Private Sub
UserForm_Activate()
Dim TempoAttesa
TempoAttesa = Now + TimeValue("00:00:03")
Application.Wait TempoAttesa
UserForm3.Hide
End Sub
Private Sub
UserForm_Initialize()
Me.Label1.Caption = "Hai 10 secondi per la risposta"
End Sub
Scriveremo del codice anche nel modulo relativo al foglio su cui eseguiamo il Quiz (nel mio caso, nel foglio 2) perchè vogliamo controllare che la nostra risposta venga scritta nella cella D14.
Private Sub
Worksheet_Change(ByVal Target As Range)
If Target.Address(RowAbsolute:=False, ColumnAbsolute:=False) <> "D14"
Then Exit Sub
If Target = "" Then Exit Sub
If Worksheets("Foglio2").Shapes(4).Visible = msoFalse Then
Risposta
End If
End Sub
Private Sub
Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address(RowAbsolute:=False, ColumnAbsolute:=False) <> "D14"
Then
Range("D14").Select
End If
End Sub
Conclusioni
Buon divertimento
prelevato sul sito www.ennius.altervista.org