With objProFill
            n = Int(Rnd * .RecordCount + 1) '隨機(jī)產(chǎn)生一個(gè)記錄號(hào)
            '獲得試題編號(hào)
            .MoveFirst
            .Move n - 1, adBookmarkFirst
            n = .Fields("編號(hào)")
            '檢查試題編號(hào)是否重復(fù)
            For j = 1 To i - 1
                If iProFill(j) = n Then Exit For
            Next
            If j < i Then
                i = i - 1           '重新抽取題號(hào)
            Else
                '檢查選中題的填空數(shù)
                m = 0
                For j = 1 To 4
                    If .Fields("空" & Chr(j + 96)) <> "" Then m = m + 1
                Next
                If iPFS(m - 2) < Val(txtDivSum(m + 1)) Then
                    iProFill(s) = n       '保存未重復(fù)的題號(hào)
                    s = s + 1
                    iPFS(m - 2) = iPFS(m - 2) + 1
                    i = i + m - 1
                Else
                    i = i - 1             '重新抽取題號(hào)
                End If
            End If
        End With
    Next
    '打開(kāi)手工選題窗口，顯示已選試題
    For i = 1 To Val(txtSum(0))
        TestDIY.lstJudge.AddItem Trim(Str(iJudge(i)))
    Next
    For i = 1 To Val(txtSum(1))
        TestDIY.lstSelOne.AddItem Trim(Str(iSelOne(i)))
    Next
    For i = 1 To Val(txtSum(2))
        If iProRead(i) = 0 Then Exit For
        TestDIY.lstProRead.AddItem Trim(Str(iProRead(i)))
    Next
    i = 1
    For i = 1 To Val(txtSum(3))
        If iProFill(i) = 0 Then Exit For
        TestDIY.lstProFill.AddItem Trim(Str(iProFill(i)))
    Next
    Me.Hide                             '隱藏試卷定制窗體
    TestDIY.Show                        '顯示手工選題窗體
    cmdSave.Enabled = True
End Sub

Private Sub cmdClear_Click()
    Dim i%
    txtName = ""
    isSaved = False
    cmdSave.Enabled = False
End Sub

Private Sub cmdDiy_Click()
    Dim i%, s%
    '檢驗(yàn)試題設(shè)置是否正確
    If Check_Seting() = False Then Exit Sub
    '根據(jù)小題數(shù)量定義數(shù)組大小
    ReDim Preserve iJudge(Val(txtSum(0)))
    ReDim Preserve iSelOne(Val(txtSum(1)))
    ReDim Preserve iProRead(Val(txtSum(2)))
    ReDim Preserve iProFill(Val(txtSum(3)))
    '顯示手工選題窗口
    For i = 1 To Val(txtSum(0))
        If iJudge(i) = 0 Then Exit For
        TestDIY.lstJudge.AddItem Trim(Str(iJudge(i)))
    Next
    For i = 1 To Val(txtSum(1))
        If iSelOne(i) = 0 Then Exit For
        TestDIY.lstSelOne.AddItem Trim(Str(iSelOne(i)))
    Next
    For i = 1 To Val(txtSum(2))
        If iProRead(i) = 0 Then Exit For
        TestDIY.lstProRead.AddItem Trim(Str(iProRead(i)))
    Next
    i = 1
    For i = 1 To Val(txtSum(3))
        If iProFill(i) = 0 Then Exit For
        TestDIY.lstProFill.AddItem Trim(Str(iProFill(i)))
    Next
    Me.Hide                             '隱藏試卷定制窗體
    TestDIY.Show                        '顯示手工選題窗體
    cmdSave.Enabled = True
End Sub

Private Sub cmdExit_Click()
    Unload Me
End Sub

Private Sub cmdSave_Click()
    '檢查是否根據(jù)設(shè)置選擇了試題
    Dim i%
    On Error GoTo DealError
    Dim strSQL$
    If iJudge(1) = 0 Then
        MsgBox "沒(méi)有根據(jù)設(shè)置選擇試題！", vbCritical, Me.Caption
    ElseIf Trim(txtName) = "" Then
        MsgBox "請(qǐng)輸入試題名稱！", vbCritical, Me.Caption
        txtName.SetFocus
        txtName = ""
    Else
        With objCn
            If .State = adStateClosed Then .Open
            If Not isSaved Then
                '創(chuàng)建試題庫(kù)，保存試題
                strSQL = "Create Table " & Trim(txtName) _
                   & " ( 編號(hào) int not null, 題型  varchar(8) not null, 分?jǐn)?shù) tinyint not null)"
                .Execute strSQL
                strSQL = "INSERT INTO 歷屆試題 (表名) VALUES ('" & Trim(txtName) & "')"
                .Execute strSQL
            Else
                If MsgBox("是否重新保存試題？", vbQuestion + _
                          vbYesNo, Me.Caption) = vbYes Then
                    '刪除原有試題
                    strSQL = "delete " & Trim(txtName) & " "
                    .Execute strSQL
                Else
                    .Close
                    Exit Sub
                End If
            End If
            '保存試題
            For i = 1 To UBound(iJudge)
                If iJudge(i) = 0 Then Exit For
                strSQL = "INSERT INTO " & Trim(txtName) & _
                     " (編號(hào),題型,分?jǐn)?shù)) VALUES (" & Str(iJudge(i)) & ",'判斷題'," _
                     & txtScore(0) & ")"
                .Execute strSQL
            Next
            For i = 1 To UBound(iSelOne)
                If iSelOne(i) = 0 Then Exit For
                strSQL = "INSERT INTO " & Trim(txtName) & _
                         " (編號(hào),題型,分?jǐn)?shù)) VALUES (" & Str(iSelOne(i)) & ",'選擇題'," _
                        & txtScore(1) & ")"
                .Execute strSQL
            Next
            For i = 1 To UBound(iProRead)
                If iProRead(i) = 0 Then Exit For
                strSQL = "INSERT INTO " & Trim(txtName) & _
                         " (編號(hào),題型,分?jǐn)?shù)) VALUES (" & Str(iProRead(i)) & ",'程序閱讀'," _
                     & txtScore(2) & ")"
                .Execute strSQL
            Next
            For i = 1 To UBound(iProFill)
                If iProFill(i) = 0 Then Exit For
                strSQL = "INSERT INTO " & Trim(txtName) & _
                         " (編號(hào),題型,分?jǐn)?shù)) VALUES (" & Str(iProFill(i)) & ",'程序填空'," _
                     & txtScore(3) & ")"
                .Execute strSQL
            Next
            MsgBox "成功保存試題！"
            '刷新往屆試題列表
            Set objOld.ActiveConnection = objCn
            If objOld.State = adStateClosed Then objOld.Open
            objOld.Requery
            cmbOld.Clear
            cmbOld.AddItem ""
            If objOld.RecordCount > 0 Then
                objOld.MoveFirst
                While Not objOld.EOF
                    cmbOld.AddItem objOld.Fields("表名")
                    objOld.MoveNext
                Wend
            End If
            isSaved = True
            If .State = adStateOpen Then .Close
        End With
    End If
    Exit Sub
DealError:
    '處理可能產(chǎn)生的錯(cuò)誤
    If Err.Number = -2147217900 Then
        MsgBox "程序執(zhí)行出錯(cuò)：請(qǐng)修改試題名稱后再嘗試保存操作！", vbCritical, Me.Caption
        txtName.SetFocus
        If objCn.State = adStateOpen Then objCn.Close
        If objOld.State = adStateOpen Then objOld.Close
    Else
        MsgBox Err.Description, vbCritical, Me.Caption
        If objCn.State = adStateOpen Then objCn.Close
        If objOld.State = adStateOpen Then objOld.Close
    End If
End Sub

Private Sub Form_Load()
    With objCn                                 '建立數(shù)據(jù)庫(kù)聯(lián)接
        .Provider = "SQLOLEDB"
        .ConnectionString = "User ID=sa;PWD=123;Data Source=(local);Initial Catalog=自測(cè)考試"
        .Open
    End With
    '訪問(wèn)數(shù)據(jù)庫(kù)獲得判斷題數(shù)據(jù)
    Set objJudge = New Recordset                '實(shí)例化對(duì)象
    With objJudge
        Set .ActiveConnection = objCn           '建立數(shù)據(jù)庫(kù)連接
        .CursorLocation = adUseClient           '指定使用客戶端游標(biāo)
        .CursorType = adOpenStatic              '指定使用靜態(tài)游標(biāo)
        .Open "SELECT * FROM 判斷題"            '獲取判斷題數(shù)據(jù)
        Set .ActiveConnection = Nothing         '斷開(kāi)數(shù)據(jù)庫(kù)連接
    End With
    '訪問(wèn)數(shù)據(jù)庫(kù)獲得單項(xiàng)選擇題數(shù)據(jù)
    Set objSelOne = New Recordset                '實(shí)例化對(duì)象
    With objSelOne
        Set .ActiveConnection = objCn           '建立數(shù)據(jù)庫(kù)連接
        .CursorLocation = adUseClient           '指定使用客戶端游標(biāo)
        .CursorType = adOpenStatic              '指定使用靜態(tài)游標(biāo)
        .Open "SELECT * FROM 選擇題"            '獲取選擇題數(shù)據(jù)
        Set .ActiveConnection = Nothing         '斷開(kāi)數(shù)據(jù)庫(kù)連接
    End With
    '訪問(wèn)數(shù)據(jù)庫(kù)獲得程序閱讀題數(shù)據(jù)
    Set objProRead = New Recordset                '實(shí)例化對(duì)象
    With objProRead
        Set .ActiveConnection = objCn           '建立數(shù)據(jù)庫(kù)連接
        .CursorLocation = adUseClient           '指定使用客戶端游標(biāo)
        .CursorType = adOpenStatic              '指定使用靜態(tài)游標(biāo)
        .Open "SELECT * FROM 程序閱讀"          '獲取程序閱讀題數(shù)據(jù)
        Set .ActiveConnection = Nothing         '斷開(kāi)數(shù)據(jù)庫(kù)連接
    End With
    '訪問(wèn)數(shù)據(jù)庫(kù)獲得程序填空題數(shù)據(jù)
     Set objProFill = New Recordset                '實(shí)例化對(duì)象
    With objProFill
        Set .ActiveConnection = objCn           '建立數(shù)據(jù)庫(kù)連接
        .CursorLocation = adUseClient           '指定使用客戶端游標(biāo)
        .CursorType = adOpenStatic              '指定使用靜態(tài)游標(biāo)
        .Open "SELECT * FROM 程序填空"          '獲取程序填空題數(shù)據(jù)
        Set .ActiveConnection = Nothing         '斷開(kāi)數(shù)據(jù)庫(kù)連接
    End With
    '訪問(wèn)數(shù)據(jù)庫(kù)獲得歷屆試題數(shù)據(jù)
    Set objOld = New Recordset                '實(shí)例化對(duì)象
    With objOld
        Set .ActiveConnection = objCn           '建立數(shù)據(jù)庫(kù)連接
        .CursorLocation = adUseClient           '指定使用客戶端游標(biāo)
        .CursorType = adOpenStatic              '指定使用靜態(tài)游標(biāo)
        .Open "SELECT * FROM 歷屆試題"          '獲取歷屆試題數(shù)據(jù)
        Set .ActiveConnection = Nothing         '斷開(kāi)數(shù)據(jù)庫(kù)連接
        cmbOld.AddItem ""
        If .RecordCount > 0 Then
            .MoveFirst
            While Not .EOF
                cmbOld.AddItem .Fields("表名")
                .MoveNext
            Wend
        End If
    End With
    objCn.Close                                 '關(guān)閉數(shù)據(jù)庫(kù)連接
End Sub

Private Sub Form_Unload(Cancel As Integer)
    '釋放數(shù)據(jù)庫(kù)連接和記錄集對(duì)象
    Set objCn = Nothing
    Set objOld = Nothing
    Set objJudge = Nothing
    Set objSelOne = Nothing
    Set objProRead = Nothing
    Set objProFill = Nothing
End Sub

Private Sub txtScore_Change(Index As Integer)
    If Val(txtSum(Index)) <> 0 Then
        txtScores(Index) = Val(txtSum(Index)) * Val(txtScore(Index))
    End If
End Sub
Private Sub txtSum_Change(Index As Integer)
    If Val(txtScore(Index)) <> 0 Then
        txtScores(Index) = Val(txtSum(Index)) * Val(txtScore(Index))
    End If
End Sub
'檢驗(yàn)小題分值輸入
Private Sub txtScore_KeyPress(Index As Integer, KeyAscii As Integer)
    If Not (Chr(KeyAscii) Like "[0-9]" Or KeyAscii = vbKeyBack) Then
        KeyAscii = 0    '輸入不是數(shù)字或退格鍵，取消輸入
    End If
End Sub
'檢驗(yàn)小題數(shù)量輸入
Private Sub txtSum_KeyPress(Index As Integer, KeyAscii As Integer)
    If Not (Chr(KeyAscii) Like "[0-9]" Or KeyAscii = vbKeyBack) Then
        KeyAscii = 0    '輸入不是數(shù)字或退格鍵，取消輸入
    End If
End Sub
'檢驗(yàn)總分輸入
Private Sub txtTotalScore_KeyPress(KeyAscii As Integer)
    If Not (Chr(KeyAscii) Like "[0-9]" Or KeyAscii = vbKeyBack) Then
        KeyAscii = 0    '輸入不是數(shù)字或退格鍵，取消輸入
    End If
End Sub

'判斷題數(shù)據(jù)訪問(wèn)屬性過(guò)程
Public Property Get Judge() As Variant
    Judge = iJudge
End Property
Public Property Let Judge(iNew As Variant)
    iJudge = iNew
End Property
'選擇題數(shù)據(jù)訪問(wèn)屬性過(guò)程
Public Property Get SelOne() As Variant
    SelOne = iSelOne
End Property
Public Property Let SelOne(iNew As Variant)
    iSelOne = iNew
End Property
'程序閱讀題題數(shù)據(jù)訪問(wèn)屬性過(guò)程
Public Property Get ProRead() As Variant
    ProRead = iProRead
End Property
Public Property Let ProRead(iNew As Variant)
    iProRead = iNew
End Property
'程序填空題數(shù)據(jù)訪問(wèn)屬性過(guò)程
Public Property Get ProFill() As Variant
    ProFill = iProFill
End Property
Public Property Let ProFill(iNew As Variant)
    iProFill = iNew
End Property

Private Function Check_Seting() As Boolean
    Dim i%, s%
    Check_Seting = False
    '檢查是否正確的設(shè)置了各類(lèi)型題的小題數(shù)和分?jǐn)?shù)
    For i = 0 To 3
        If Val(txtSum(i)) = 0 Then
            MsgBox "請(qǐng)?jiān)O(shè)置正確的小題數(shù)量！", vbCritical, Me.Caption
            txtSum(i).SetFocus
            Exit Function
        ElseIf Val(txtScore(i)) = 0 Then
            MsgBox "請(qǐng)?jiān)O(shè)置正確的小題分?jǐn)?shù)！", vbCritical, Me.Caption
            txtScore(i).SetFocus
            Exit Function
        End If
        s = s + Val(txtScores(i))
    Next
    '檢查小題分?jǐn)?shù)合計(jì)與總分是否一致
    If Val(txtTotalScore) <> Val(s) Then
        MsgBox "小題分?jǐn)?shù)合計(jì)與試卷總分不一致！", vbCritical, Me.Caption
        Exit Function
    End If
    '檢驗(yàn)程序閱讀分題干數(shù)設(shè)置是否正確
    If Val(txtDivSum(0)) + Val(txtDivSum(1)) * 2 + Val(txtDivSum(2)) * 3 <> Val(txtSum(2)) Then
        MsgBox "程序閱讀題分題干數(shù)設(shè)置不正確！", vbCritical, Me.Caption
        txtDivSum(0).SetFocus
        Exit Function
    End If
    '檢驗(yàn)程序填空題分題干數(shù)設(shè)置是否正確
    If Val(txtDivSum(3)) * 2 + Val(txtDivSum(4)) * 3 + Val(txtDivSum(5)) * 4 <> Val(txtSum(3)) Then
        MsgBox "程序填空題分題干數(shù)設(shè)置不正確！", vbCritical, Me.Caption
        txtDivSum(3).SetFocus
        Exit Function
    End If
    Check_Seting = True
End Function