Jako trenér byste svým studentům uspořádali několik seminářů. Nyní je čas, abyste se svými studenty sdíleli sešit aplikace Excel, který vám pomůže zjistit, jak moc porozuměli. Podle tohoto článku si připravte list digitálních zkoušek s výběrem z několika možností.
Stáhnout nyní
Pokud chcete start používat software co nejdříve, pak můžete:
Jinak si můžete přečíst obsah níže, pokud si chcete udělat kutilství.
Připravíme GUI
Obsah
Připravme databázi
Přidejte otázky, možnosti a správnou odpověď na list „Databáze“
Udělejme to funkční
Zkopírujte tento skript do nového modulu v sešitu s povolenými makry.
Sub Prepare_Test()
Dim lr As Long
Dim r As Long
Dim rinq As Long
rinq = 0
lr = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row
For r = 3 To lr
rinq = rinq + 6
Sheets("Test").Range("C" & rinq).Value = Sheets("Database").Range("A" & r).Value
Sheets("Test").Range("C" & rinq + 1).Value = Sheets("Database").Range("B" & r).Value
Sheets("Test").Range("C" & rinq + 2).Value = Sheets("Database").Range("C" & r).Value
Sheets("Test").Range("C" & rinq + 3).Value = Sheets("Database").Range("D" & r).Value
Sheets("Test").Range("C" & rinq + 4).Value = Sheets("Database").Range("E" & r).Value
Next r
End Sub
Sub Show_Result()
Dim lr As Long
Dim r As Long
Dim rinq As Long
rinq = 0
Sheets("Database").Visible = -1
Sheets("Summary").Visible = -1
lr = Sheets("Database").Range("A" & Rows.Count).End(xlUp).Row
Dim v_ccount As Long
v_ccount = 0
For r = 3 To lr
Dim v_answer As String
v_answer = "Option " & Sheets("Database").Range("F" & r).Value
rinq = rinq + 6
If Sheets("Test").Range("C" & rinq + 1).Interior.Color = vbYellow And Sheets("Test").Range("B" & rinq + 1).Value = v_answer Then
v_ccount = v_ccount + 1
End If
If Sheets("Test").Range("C" & rinq + 2).Interior.Color = vbYellow And Sheets("Test").Range("B" & rinq + 2).Value = v_answer Then
v_ccount = v_ccount + 1
End If
If Sheets("Test").Range("C" & rinq + 3).Interior.Color = vbYellow And Sheets("Test").Range("B" & rinq + 3).Value = v_answer Then
v_ccount = v_ccount + 1
End If
If Sheets("Test").Range("C" & rinq + 4).Interior.Color = vbYellow And Sheets("Test").Range("B" & rinq + 4).Value = v_answer Then
v_ccount = v_ccount + 1
End If
Next r
Sheets("Summary").Range("C7").Value = Sheets("Test").Range("F3").Value
Sheets("Summary").Range("C11").Value = lr - 2
Sheets("Summary").Range("F11").Value = v_ccount
Sheets("Summary").Range("I11").Value = (lr - 2) - v_ccount
End Sub
Zkopírujte tento skript do okna kódu listu „Test“
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim ar As Long
ar = Target.Row
Range("C" & ar & ":F" & ar).Interior.Color = vbYellow
End Sub
Zkopírujte tento skript do okna kódu „ThisWorkook“
Private Sub Workbook_Open()
Call Module1.Prepare_Test
Sheets("Database").Visible = 2
Sheets("Summary").Visible = 2
End Sub
Jak to funguje?
Když uživatel otevře sešit, makro se spustí a skryje listy „Databáze“ a „Souhrn“. Pokud list „Databáze“ není uživateli skryt, jsou všechny odpovědi zveřejněny. Rovněž není nutné, aby student viděl list „Shrnutí“. Před odesláním sešitu uživatelům by mělo být spuštěno makro „Prepare_Test“, které vyplní list „Test“. Uživatelé mohou vybrat libovolnou možnost a makro vybranou odpověď zvýrazní žlutě. Makro „Show_Result“ porovná vybrané možnosti na listu „Test“ s odpověďmi na listu „Databáze“ a určí počet správných odpovědí.
Skryté listy?
Skript VBA nemůže upozornit na vlastnosti poškozeného listu aplikace Excel. V takovém případě, obnovit Excel list a znovu spusťte makro.
Úvod autora:
Nick Vipond je odborníkem na obnovu dat DataNumen, Inc., která je světovým lídrem v oblasti technologií pro obnovu dat, včetně poškozené slovo a softwarové produkty pro obnovení aplikace Outlook. Pro více informací navštivte www.datanumen.com