VBA 试图做一个试卷系统，可以根据玩家选择试卷，进行答题，打分，甚至分析等

 

第1版：

• 现在只能只第1个试卷开始，还不能实现选试卷
• 基本思路
• 1 在打开EXCEL时，遍历papers 
• 2 弹提示框，让玩家选试卷，----现在还不行
• 3 逐个显示题目，现在做的很挫，还不是单选框
• 4 可以积分
• 5 需要提前录入试卷，可以考虑自动导入？

 

Sub collect_papers()
'这个得放在文件打开时

Dim sh1 As Object
i = 1

For Each sh1 In ThisWorkbook.Worksheets
    If sh1.Name Like "*paper*" Then
       ThisWorkbook.Worksheets("sum").Cells(i + 1, 1) = i
       ThisWorkbook.Worksheets("sum").Cells(i + 1, 2) = sh1.Name
       i = i + 1
    End If
Next

End Sub


Sub select_paper()
'调用考试过程的函数，并且把试卷名当参数传过去

paper_count = Application.WorksheetFunction.CountA(Range("b:b")) - 1

'这里应该让玩家选卷子
'现在还不会做单选框等，现在就轮流每张试卷都做吧
MsgBox "请选择一份试卷", vbYesNo, "选择试卷"
' x1=MsgBox("请选择一份试卷", vbYesNo, "选择试卷") 如果用函数形式就需要有赋值=

paper

End Sub



Sub paper()     '暂时没带参数paper_name

'Application.WorksheetFunction.CountA(Range("A:A")) - 1
For i = 2 To 3

LINE_SELECT:
str1 = Cells(i, 3) & Cells(i, 4) & Cells(i, 5) & Cells(i, 6) & Cells(i, 7) & Cells(i, 8) & Cells(i, 9) & Cells(i, 10)
m1 = InputBox(str1 & "请在ABCD中选择1个输入")

Select Case m1

Case "A"
   m1 = "A"
Case "B"
   m1 = "B"
Case "C"
   m1 = "C"
Case "D"
   m1 = "D"
Case Else
   GoTo LINE_SELECT
End Select

If m1 = Cells(i, 11) Then
   Cells(i, 12) = m1
   Cells(i, 13) = 10
   MsgBox "答对了"
Else
   Cells(i, 12) = m1
   Cells(i, 13) = 0
   MsgBox "答错了"

End If

Next

MsgBox "答题完毕" & "得分是" & Application.Sum(Range("m:m")) & "/" & 10 * (Application.WorksheetFunction.CountA(Range("A:A")) - 1)

End Sub