TEST XLS Vyřešeno

[M.I.RASL]

Přátelé poraďte,

vytvořil jsem si testový soubor xls, viz.příloha. Potřeboval bych, aby tento po uplynutí zadaného časového limitu vydal například zvukový signál. Dále se mě zdá, že mé vyhodnocení testu je dosti kostrbaté. Nemáte lepší řešení, které bych mohl využít?

Moc děkuji za Vaší případnou pomoc.

[Reklama]

[navstevnik]

nekollik tipu (ve VBA):
- v udalostni procedure Workbook_Open() skryt list s testovymi otazkami - Sheets("test").Visible = False.
- na uvodnim listu vlozit ovladaci prvek prikazove tlacitko, ktere zobrazi po stisku list s testem a zaroven metodou OnTime spustit casovani limitu pro trvani testu.
- v pripade, ze test nebude vykonan v limitu, skryt list s testem, MsgBox so prekroceni limitu, a prikaz Beep (nejspis bude potreba generovat ton jinak) a zobrazit vyhodnoceni.
- pri dosazeni celkoveho poctu odpovedi ukoncit casovani, skryt test a zobrazit vyhodnoceni.
- vyhodnocovani spravnosti: nejspis bych na dalsim skrytem kistu (heslo) vlozil do shodnych pozit spravne odpovedi a pak porovnal s odpovedni v testech

[M.I.RASL]

Díky, ale na mě je to příliš složité.

[mike007]

S tím zvukovým upozorněním to udělat neumím. Beep není moc slyšet ( leda ho tam dát vícekrát). Ale co třeba použít uložení a zavření dokumentu? Čili po uplynutí času by makro zobrazilo hlášku, že čas vyhrazený pro vypracování testu vypršel, dokument by se uložil a zavřel.

Jestli ti to stačí takto, tak jukni do přílohy. V tuto chvíli je tam nastaveno, že po 1 minutě se provede akce. Můžeš si to tedy otestovat. Stačí v levém horním rohu kliknout na tlačítko START.

Makro, které jsem ti napsal do dokumentu máš tady :

Kód: Vybrat vše

Public vartimer As Variant
Const TimeOut = 1 'minut
 
Sub akce()
' po vypršení času zahlásíme konec, dokument se uloží a zavře.
MsgBox "Čas vyhrazený pro vyplnění testu vypršel. Děkujeme.", vbOKOnly, "KONEC"
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
 
Sub spustit()
MsgBox "Test byl spuštěn. Máte 20 minut na jeho vyplnění", vbOKOnly, "START"
    vartimer = Format(Now + TimeSerial(0, TimeOut, 0), "hh:mm:ss")
    If vartimer = "" Then Exit Sub
    Application.OnTime TimeValue(vartimer), "akce"
End Sub

Čas si pak změň u Const TimeOut = 1 'minut na požadovaných 20 minut,
tj. na Const TimeOut = 20 'minut

Mike

[M.I.RASL]

Díky moc,

je to perfektní.