paperproperty.frm

这是我们公司的题库管理系统

                            Chapter(i, k) = Chapter(i, k) + objRsMore.RecordCount
                        Next
                    Case 3  '检查填空题题量分配是否有效
                        objRsSpace.Filter = strFilter
                        If objRsSpace.RecordCount < Int(cmbChapter(i).ItemData(j) * _
                            txtCount(i) / 100) Then
                            MsgBox "<" & News(i) & "><" & objRsChapter!名称 & ">中只有<" _
                                & objRsSpace.RecordCount & ">道试题，小题百分比最多<" _
                                & Int(objRsSpace.RecordCount / Val(txtCount(i)) * 100) _
                                & ">", vbCritical
                                cmbChapter(i).ListIndex = j
                                Exit Sub
                        End If
                        '小题数通过检验，统计各类难度试题数量
                        For k = 0 To 2
                            objRsSpace.Filter = strFilter & " and 难度=" & k
                            Chapter(i, k) = Chapter(i, k) + objRsSpace.RecordCount
                        Next
                End Select
            Next
        End If
    Next
    '按难度检查题量分配是否合理
    For i = 0 To 3
        '检查难度属于“难”的题题量分配是否有效
        If Chapter(i, 0) < Int(Val(txtCount(i)) * txtLevel0(i) / 100) Then
            MsgBox News(i) & "题库中难度属于“难”的题只有<" _
                & Chapter(i, 0) & ">道，难度百分比最大可为<" _
                & Int(Chapter(i, 0) / Val(txtCount(i)) * 100) _
                & ">", vbCritical
                txtLevel0(i).SetFocus
                Exit Sub
        End If
        '检查难度属于“一般”的题题量分配是否有效
        If Chapter(i, 1) < Int(Val(txtCount(i)) * txtLevel1(i) / 100) Then
            MsgBox News(i) & "题库中难度属于“一般”的题只有<" _
                & Chapter(i, 1) & ">道，难度百分比最大可为<" _
                & Int(Chapter(i, 1) / Val(txtCount(i)) * 100) _
                & ">", vbCritical
                txtLevel1(i).SetFocus
                Exit Sub
        End If
        '检查难度属于“容易”的题题量分配是否有效
        If Chapter(i, 2) < Int(Val(txtCount(i)) * txtLevel2(i) / 100) Then
            MsgBox News(i) & "题库中难度属于“容易”的题只有<" _
                & Chapter(i, 2) & ">道，难度百分比最大可为<" _
                & Int(Chapter(i, 2) / Val(txtCount(i)) * 100) _
                & ">", vbCritical
                txtLevel2(i).SetFocus
                Exit Sub
        End If
    Next
    MsgBox "试卷参数设置正确，可以生成试卷！", vbInformation
    '取消各个记录集的过虑设置
    objRsSpace.Filter = ""
    objRsMore.Filter = ""
    objRsSingle.Filter = ""
    objRsJudge.Filter = ""
    cmdMakePaper.Enabled = True
    Exit Sub
DealError:
    ShowError "程序执行出错，错误信息如下：" & vbCrLf & Err.Description
End Sub

Private Sub cmdMakePaper_Click()
    On Error GoTo DealError
    Randomize Timer
    Dim Level0%(3), Level1%(3), Level2%(3), i%, n%, strTest$, strAnswer$
    Dim Count%(3), Selected$, Chapter%(), Ok, Abcd, more%, doTime As Long
    doTime = Timer   '开始计算生成试题时间
    Abcd = Array("A", "B", "C", "D")
    ReDim Chapter(3, cmbChapter(0).ListCount - 1)
    '计算各类题型的难度小题数
    For i = 0 To 3
        n = Val(txtCount(i))
        Count(i) = n
        Level0%(i) = Int(Val(txtLevel0(i)) * n / 100)
        Level1%(i) = Int(Val(txtLevel1(i)) * n / 100)
        Level2%(i) = Int(Val(txtLevel2(i)) * n / 100)
        If Level0%(i) + Level1%(i) + Level2%(i) <> n Then _
            Level1%(i) = n - Level0%(i) - Level2%(i)
    Next
    For i = 0 To 3
        cmbChapter(i).ItemData(0) = 20
        cmbChapter(i).ItemData(1) = 30
        cmbChapter(i).ItemData(2) = 30
        cmbChapter(i).ItemData(3) = 20
    Next
    '计算个章节各类题型的小题数
    For i = 0 To 3
        For j = 0 To cmbChapter(0).ListCount - 1
            Chapter(i, j) = Int(cmbChapter(i).ItemData(j) * Val(txtCount(i)) / 100)
        Next
        n = 0
        For j = 0 To cmbChapter(0).ListCount - 1
            n = n + Chapter(i, j)
        Next
        If n <> Val(txtCount(i)) Then Chapter(i, 0) = Chapter(i, 0) + Val(txtCount(i)) - n
    Next
    '将cmbchapter列表itemdata中的百分比数转换为章节编号
    For i = 0 To 3
        For j = 0 To cmbChapter(0).ListCount - 1
            objRsChapter.MoveFirst
            objRsChapter.Find "名称='" & cmbChapter(i).List(j) & "'"
            cmbChapter(i).ItemData(j) = objRsChapter!编号
        Next
    Next
    
    '生成试卷
    For i = 0 To 3
        Selected = ""
        Select Case i
            Case 0  '选择判断题
                strTest = strTest & "一、判断题。（共" & txtCount(i) _
                    & "，每小题" & txtAvg(i) & "分，共" & txtScore(i) & "分）" & vbCrLf
                strAnswer = strAnswer & "一、判断题。（共" & txtCount(i) _
                    & "，每小题" & txtAvg(i) & "分，共" & txtScore(i) & "分）" & vbCrLf
                j = 1
                While Count(i) > 0
                    '随即产生一个未选择的试题的记录序号
                    Do
                        If Timer - doTime > 30 Then
                            MsgBox "本次生成试题花费时间过长，退出重试！", vbCritical
                            Exit Sub
                        End If
                        n = Int(Rnd * objRsJudge.RecordCount + 1)
                    Loop Until InStr(Selected, "#" & n & "#") = 0
                    Selected = Selected & "#" & n & "#"
                    objRsJudge.MoveFirst
                    objRsJudge.Move n - 1
                    Select Case objRsJudge!难度
                        Case 0
                            If Level0(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 3
                                    If cmbChapter(i).ItemData(n) = objRsJudge!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                    strTest = strTest & j & "、" & objRsJudge!题干 & "（ ）" & vbCrLf
                                    strAnswer = strAnswer & j & "、"
                                    If objRsJudge!答案 Then
                                        strAnswer = strAnswer & "错误"
                                    Else
                                        strAnswer = strAnswer & "正确"
                                    End If
                                    strAnswer = strAnswer & vbCrLf
                                    j = j + 1
                                    Chapter(i, n) = Chapter(i, n) - 1
                                    Level0(i) = Level0(i) - 1
                                    Count(i) = Count(i) - 1
                                    If Not IsNull(objRsJudge!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsJudge!图片
                                End If
                            End If
                        Case 1
                            If Level1(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 3
                                    If cmbChapter(i).ItemData(n) = objRsJudge!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                    strTest = strTest & j & "、" & objRsJudge!题干 & "（ ）" & vbCrLf
                                    strAnswer = strAnswer & j & "、"
                                    If objRsJudge!答案 Then
                                        strAnswer = strAnswer & "错误"
                                    Else
                                        strAnswer = strAnswer & "正确"
                                    End If
                                    strAnswer = strAnswer & vbCrLf
                                    j = j + 1
                                    Chapter(i, n) = Chapter(i, n) - 1
                                    Level1(i) = Level1(i) - 1
                                    Count(i) = Count(i) - 1
                                    If Not IsNull(objRsJudge!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsJudge!图片
                                End If
                            End If
                        Case 2
                            If Level2(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 3
                                    If cmbChapter(i).ItemData(n) = objRsJudge!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                    strTest = strTest & j & "、" & objRsJudge!题干 & "（ ）" & vbCrLf
                                    strAnswer = strAnswer & j & "、"
                                    If objRsJudge!答案 Then
                                        strAnswer = strAnswer & "错误"
                                    Else
                                        strAnswer = strAnswer & "正确"
                                    End If
                                    strAnswer = strAnswer & vbCrLf
                                    j = j + 1
                                    Chapter(i, n) = Chapter(i, n) - 1
                                    Level2(i) = Level2(i) - 1
                                    Count(i) = Count(i) - 1
                                    If Not IsNull(objRsJudge!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsJudge!图片
                                End If
                            End If
                    End Select
                Wend
            Case 1  '卸载单选题
                strTest = strTest & "二、单选题。（共" & txtCount(i) _
                    & "，每小题" & txtAvg(i) & "分，共" & txtScore(i) & "分）" & vbCrLf
                strAnswer = strAnswer & "二、单选题。（共" & txtCount(i) _
                    & "，每小题" & txtAvg(i) & "分，共" & txtScore(i) & "分）" & vbCrLf
                j = 1
                While Count(i) > 0
                    '随即产生一个未选择的试题的记录序号
                    Do
                        If Timer - doTime > 30 Then
                            MsgBox "本次生成试题花费时间过长，退出重试！", vbCritical
                            Exit Sub
                        End If
                        n = Int(Rnd * objRsSingle.RecordCount + 1)
                    Loop Until InStr(Selected, "#" & n & "#") = 0
                    Selected = Selected & "#" & n & "#"
                    objRsSingle.MoveFirst
                    objRsSingle.Move n - 1
                    Select Case objRsSingle!难度
                        Case 0
                            If Level0(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 3
                                    If cmbChapter(i).ItemData(n) = objRsSingle!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                    strTest = strTest & j & "、" & objRsSingle!题干 & vbCrLf
                                    strTest = strTest & "    A、" & objRsSingle!选项1 & vbCrLf
                                    strTest = strTest & "    B、" & objRsSingle!选项2 & vbCrLf
                                    strTest = strTest & "    C、" & objRsSingle!选项3 & vbCrLf
                                    strTest = strTest & "    D、" & objRsSingle!选项4 & vbCrLf
                                    strAnswer = strAnswer & j & "、" & Abcd(objRsSingle!答案) & vbCrLf
                                    j = j + 1
                                    Chapter(i, n) = Chapter(i, n) - 1
                                    Level0(i) = Level0(i) - 1
                                    Count(i) = Count(i) - 1
                                    If Not IsNull(objRsSingle!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsSingle!图片
                                End If
                            End If
                        Case 1
                            If Level1(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 3
                                    If cmbChapter(i).ItemData(n) = objRsSingle!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                    strTest = strTest & j & "、" & objRsSingle!题干 & vbCrLf
                                    strTest = strTest & "    A、" & objRsSingle!选项1 & vbCrLf
                                    strTest = strTest & "    B、" & objRsSingle!选项2 & vbCrLf
                                    strTest = strTest & "    C、" & objRsSingle!选项3 & vbCrLf
                                    strTest = strTest & "    D、" & objRsSingle!选项4 & vbCrLf
                                    strAnswer = strAnswer & j & "、" & Abcd(objRsSingle!答案) & vbCrLf
                                    j = j + 1
                                    Chapter(i, n) = Chapter(i, n) - 1
                                    Level1(i) = Level1(i) - 1
                                    Count(i) = Count(i) - 1
                                    If Not IsNull(objRsSingle!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsSingle!图片
                                End If
                            End If
                        Case 2
                            If Level2(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 3
                                    If cmbChapter(i).ItemData(n) = objRsSingle!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                    strTest = strTest & j & "、" & objRsSingle!题干 & vbCrLf
                                    strTest = strTest & "    A、" & objRsSingle!选项1 & vbCrLf
                                    strTest = strTest & "    B、" & objRsSingle!选项2 & vbCrLf
                                    strTest = strTest & "    C、" & objRsSingle!选项3 & vbCrLf
                                    strTest = strTest & "    D、" & objRsSingle!选项4 & vbCrLf
                                    strAnswer = strAnswer & j & "、" & Abcd(objRsSingle!答案) & vbCrLf
                                    j = j + 1
                                    Chapter(i, n) = Chapter(i, n) - 1
                                    Level2(i) = Level2(i) - 1
                                    Count(i) = Count(i) - 1
                                    If Not IsNull(objRsSingle!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsSingle!图片
                                End If
                            End If
                    End Select
                Wend
            Case 2  '选择多选题
                strTest = strTest & "三、多选题。（共" & txtCount(i) _
                    & "，每小题" & txtAvg(i) & "分，共" & txtScore(i) & "分）" & vbCrLf
                strAnswer = strAnswer & "三、多选题。（共" & txtCount(i) _
                    & "，每小题" & txtAvg(i) & "分，共" & txtScore(i) & "分）" & vbCrLf
                j = 1
                While Count(i) > 0
                    '随即产生一个未选择的试题的记录序号
                    Do
                        If Timer - doTime > 30 Then
                            MsgBox "本次生成试题花费时间过长，退出重试！", vbCritical
                            Exit Sub
                        End If
                        n = Int(Rnd * objRsMore.RecordCount + 1)
                    Loop Until InStr(Selected, "#" & n & "#") = 0
                    Selected = Selected & "#" & n & "#"
                    objRsMore.MoveFirst
                    objRsMore.Move n - 1
                    Select Case objRsMore!难度
                        Case 0
                            If Level0(i) > 0 Then
                                '检查本章试题是否已选够
                                For n = 0 To 3
                                    If cmbChapter(i).ItemData(n) = objRsMore!章节 Then Exit For
                                Next
                                If Chapter(i, n) > 0 Then
                                    strTest = strTest & j & "、" & objRsMore!题干 & vbCrLf
                                    strTest = strTest & "    A、" & objRsMore!选项1 & vbCrLf
                                    strTest = strTest & "    B、" & objRsMore!选项2 & vbCrLf
                                    strTest = strTest & "    C、" & objRsMore!选项3 & vbCrLf
                                    strTest = strTest & "    D、" & objRsMore!选项4 & vbCrLf
                                    strAnswer = strAnswer & j & "、"
                                     For more = 0 To 3
                                        If Mid(objRsMore!答案, more + 1, 1) = "1" Then _
                                            strAnswer = strAnswer & Abcd(more) & "，"
                                    Next
                                    strAnswer = strAnswer & vbCrLf
                                    j = j + 1
                                    Chapter(i, n) = Chapter(i, n) - 1
                                    Level0(i) = Level0(i) - 1
                                    Count(i) = Count(i) - 1
                                    If Not IsNull(objRsMore!图片) Then _
                                        strTest = strTest & "本题图片：" & objRsMore!图片
                                End If
                            End If
                        Case 1
                            If Level1(i) > 0 Then