paperproperty.frm

很不错的哦!!! !!! !!! !!! !!!1

                             If objRsMore.RecordCount < Int(cmbChapter(i).ItemData(j) * txtCount(i) / 100) Then
                                MsgBox "<" & News(i) & "><" & objRsChapter!名称 & ">中只有<" & objRsMore.RecordCount _
                                & ">道试题，小题百分比最多<" & Int(objRsMore.RecordCount / Val(txtCount(i)) * 100) _
                                & ">", vbCritical
                                cmbChapter(i).ListIndex = j
                             Exit Sub
                             End If
                             '小题数通过检验，统计各类难度试题数量
                             For k = 0 To 2
                                 objRsMore.Filter = strFilter & "And 难度=" & k
                                 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
                                 objSpace.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)) * txtLeve10(i) / 100) Then
                MsgBox News(i) & "题库中难度属于“难”的题只有<" & Chapter(i, 0) & ">道，难度百分比最大可为<" & Int(Chapter(i, 0) / Val(txtCount(i)) * 100) _
                & ">", vbCritical
                txtLeve10(i).SetFocus
                Exit Sub
             End If
             '检查难度属于“一般”的题题量分配是否有效
             If Chapter(i, 1) < Int(Val(txtCount(i)) * txtLeve11(i) / 100) Then
                MsgBox News(i) & "题库中难度属于“一般”的题只有<" & Chapter(i, 1) & ">道，难度百分比最大可为<" & Int(Chapter(i, 1) / Val(txtCount(i)) * 100) _
                & ">", vbCritical
                txtLeve11(i).SetFocus
                Exit Sub
             End If
             '检查难度属于“容易”的题题量分配是否有效
             If Chapter(i, 2) < Int(Val(txtCount(i)) * txtLeve12(i) / 100) Then
                MsgBox News(i) & "题库中难度属于“容易”的题只有<" & Chapter(i, 2) & ">道，难度百分比最大可为<" & Int(Chapter(i, 2) / Val(txtCount(i)) * 100) _
                & ">", vbCritical
                txtLeve12(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 cmdExit_Click()
Unload Me                                  '关闭窗体
End Sub

Private Sub cmdMakePaker_Click()
   On Error GoTo DealError
   Randomize Timer
   Dim Leve10%(3), Leve11%(3), leve12%(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
       Leve10%(i) = Int(Val(txtLeve10(i)) * n / 100)
       Leve11%(i) = Int(Val(txtLeve11(i)) * n / 100)
       leve12%(i) = Int(Val(txtLeve12(i)) * n / 100)
       If Leve10%(i) + Leve11%(i) + leve12%(i) <> n Then _
          Leve11%(i) = n - Leve10%(i) - leve12%(i)
       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列表中的百分比数转换为章节编号
   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 Leve10(i) > 0 Then
                           '检查本章试题是否已选够
                           For n = 0 To 3
                           If cmbChapter(i).ItemData(n) = objRsJudge!章节 Then
 Exit For
                           End If
                        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
                           Leve10(i) = Leve10(i) - 1
                           Count(i) = Count(i) - 1
                           If Not IsNull(objRsJudge!图片) Then strTest = strTest & "本题图片：" & objRsJudge!图片
                           End If
                        End If
        Case 1
              If Leve11(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
                 Leve11(i) = Leve11(i) - 1
                 Count(i) = Count(i) - 1
                 If Not IsNull(objRsJudge!图片) Then strTest = strTest & "本题图片：" & objRsJudge!图片
                 End If
               End If
       Case 2
              If leve12(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
               leve12(i) = leve12(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 Leve10(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
                            Leve10(i) = Leve10(i) - 1
                            Count(i) = Count(i) - 1
                            If Not IsNull(objRsSingle!图片) Then strTest = strTest & "本题图片：" & objRsSingle!图片
                            End If
                            End If
                        Case 1
                            If Leve11(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
                            Leve11(i) = Leve11(i) - 1
                            Count(i) = Count(i) - 1
                            If Not IsNull(objRsSingle!图片) Then strTest = strTest & "本题图片：" & objRsSingle!图片
                            End If
                            End If
                        Case 2
                            If leve12(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
                            leve12(i) = leve12(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 Leve10(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