Som trener ville du ha gjennomført flere seminarer for studentene dine. Nå er det på tide at du deler en Excel-arbeidsbok med elevene dine som vil hjelpe deg å identifisere hvor mye de har forstått. Forbered digitalt flervalgsark ved å følge denne artikkelen.
Last ned nå
Hvis du ønsker å starFor å bruke programvaren så snart som mulig, kan du:
Ellers, hvis du vil gjøre DIY, kan du lese innholdet nedenfor.
La oss forberede GUI
Innhold
La oss forberede databasen
Legg til spørsmål, alternativer og riktig svar på arket "Database"
La oss gjøre det funksjonelt
Kopier dette skriptet til en ny modul i den makroaktiverte arbeidsboken.
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
Kopier dette skriptet inn i kodevinduet på arket "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
Kopier dette skriptet inn i kodevinduet til "ThisWorkook"
Private Sub Workbook_Open()
Call Module1.Prepare_Test
Sheets("Database").Visible = 2
Sheets("Summary").Visible = 2
End Sub
Hvordan virker det?
Når en bruker åpner arbeidsboken, vil makroen kjøre for å skjule arkene "Database" og "Sammendrag". Hvis arket "Database" ikke er skjult for brukeren, blir alle svar avslørt. Det er heller ikke nødvendig for en student å se «Sammendrag»-arket. Før du sender arbeidsboken til brukere, bør makroen "Prepare_Test" kjøres som vil fylle arket "Test". Brukere kan velge hvilket som helst alternativ og makroen vil markere det valgte svaret i gult. Makroen "Show_Result" vil sammenligne utvalgte alternativer på arket "Test" med svarene på arket "Database" og identifiserer antallet riktige svar.
Har ikke ark gjemt?
VBA-skript kan ikke varsle egenskapene til et ødelagt Excel-regneark. I et slikt tilfelle, gjenopprette Excel regnearket og kjøre makroen på nytt.
Forfatterintroduksjon:
Nick Vipond er en datagjenopprettingsekspert innen DataNumen, Inc., som er verdensledende innen datagjenopprettingsteknologier, inkludert skadet Word og Outlook-programvareprodukter. For mer informasjon besøk www.datanumen. Med