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 e Timer per un Quiz

Come ultimo esempio ho preparato 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)

  A B    
1 Il fuoco è caldo o freddo? Caldo      il quiz
2 Ce cos'è una mosca? Un insetto
3 Quanto fa 10 - 6? 4
4 Quanto fa 10 / 2? 5
5 Becco ricurvo Rostro
6 Un veicolo di città Autobus
7 Il radar usato dai sottomarini Sonar
8 Illumina il cielo durante un temporale Fulmine
9 Una strada a scorrimento veloce Autostrada
10 Si apre in banca Contocorrente
11 Si usa durante un sorpasso Freccia
12 Necessari per respirare Polmoni
13 Le vocali nel nostro alfabeto aeiou
14 Battono per il freddo Denti
15 ecc.......  

Fatto questo si va nell'editor del VBA e si disegna una UserForm come questa

la userform

(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. Per rendere pubblica una variabile è necessario dichiararla in testa al modulo

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.

prima immaginee dopo SendKeys "{ENTER}" si otterràseconda immagine per cui si rendono necessarie le successive istruzioni

Range("D14") = Range("D15")
Range("D15") = ""

 

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

Buon divertimento