frmcjlr.frm

毕业设计的学生成绩管理

                                Cell1.DoSetCellString numcol, 1, "理论成绩"
                                Cell1.DoSetCellString numcol + 1, 1, "实训成绩"
                                Cell1.DoSetCellString numcol + 2, 1, "总成绩"
                                Cell1.DoSetCellAlignment numcol, 1, 36
                                Cell1.DoSetCellAlignment numcol + 1, 1, 36
                                Cell1.DoSetCellAlignment numcol + 2, 1, 36
                                Cell1.DoSetCellReadOnly numcol, 1, True
                                Cell1.DoSetCellReadOnly numcol + 1, 1, True
                                Cell1.DoSetCellReadOnly numcol + 2, 1, True
                                numcol = numcol + 2
                            Case "2"
'                           "学分"型评分方式
                                Cell1.DoSetCellString numcol, 1, "学分"
                                Cell1.DoSetCellAlignment numcol, 1, 36
                                Cell1.DoSetCellReadOnly numcol, 1, True
                            Case "3"
'                           "考查成绩"型评分方式
                                Cell1.DoSetCellString numcol, 1, "考查成绩"
                                Cell1.DoSetCellAlignment numcol, 1, 36
                                Cell1.DoSetCellReadOnly numcol, 1, True
                        End Select
                        numcol = numcol + 1
                    End If
                Next
'开始显示学号、姓名和已经录入的成绩
                strExec = "Select mc From XTCSB where lb=1"
'               从系统参数表获取考查课成绩名称（“优秀”、“良好”、“及格”等，由“lb=1”指示）
                Set objRs1 = objCon.Execute(strExec)
                If objRs1.EOF Then
'               系统参数表中没有考查课成绩名称，采用默认值
                    strtemp1 = "优秀" & Chr(10) & "良好" & Chr(10) & "中等" & Chr(10) & "及格" & Chr(10) & "不及格"
'                   按Cell控件的要求，将列表显示的内容用Chr(10)分割
                Else
                    strtemp1 = ""
                    Do While Not objRs1.EOF
                        strtemp1 = strtemp1 & objRs1("mc") & Chr(10)
                        objRs1.MoveNext
                    Loop
                End If
                strExec = "Select * From " & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text) & _
                    " Where xh in (Select xh From XSDAB Where nj='" & Text1.Text & "' And xbbh='" & fGetXbbh(Combo1.Text) & _
                    "' And zybh='" & fGetZybh(Combo2.Text) & "'" & IIf(Text2.Text <> "", " And bj='" & Trim(Text2.Text) & "')", ")")
'               根据系别、专业、年级、学期和班级形成多级查询语句，并从成绩库（由fSckcbmc()生成，如“2000010101”）中检索成绩数据
                Set objRs1 = objCon.Execute(strExec)
                If objRs1.EOF Then
'               没有录入过成绩，从档案库取学号和姓名
                    strExec = "Select xh,xm From XSDAB Where nj='" & Text1.Text & "' And xbbh='" & fGetXbbh(Combo1.Text) & _
                        "' And zybh='" & fGetZybh(Combo2.Text) & "'" & IIf(Text2.Text <> "", " And bj='" & Trim(Text2.Text) & "'", "")
                    Set objRs = objCon.Execute(strExec)
                    If objRs.EOF Then
                        MsgBox "没有找到指定条件的学生档案！", vbCritical, "错误信息"
                        Command2.Enabled = False
'                       没有数据，不允许保存
                    Else
                        numI = 2
                        Do While Not objRs.EOF
'                       显示学号和姓名
                            Cell1.DoAppendRow 1
                            Cell1.DoSetCellString 0, numI, Trim(objRs("xh"))
                            Cell1.DoSetCellReadOnly 0, numI, True
                            Cell1.DoSetCellString 1, numI, Trim(objRs("xm"))
                            Cell1.DoSetCellReadOnly 1, numI, True
                            objRs.MoveNext
                            numI = numI + 1
                        Loop
                        Set objRs = objCon.Execute("Select * From XKQKB Where kcbmc='" & fSckcbmc(Text1.Text, Combo1.Text, _
                            Combo2.Text, Combo5.Text) & "'")
'                       根据系别(Combo1)、专业(Combo2)、年级(Text1)和学期(Combo5)，从选课情况表查询选课情况
                        numI = 2
                        For numcol = 1 To 10
                            If objRs("kcbh" & Trim(Str(numcol))) <> "" Then
'                           第numcol号课程为已排定的课程
                                Select Case Trim(objRs("pffs" & Trim(Str(numcol))))
'                               根据评分方式的不同，设置不同形式的成绩计算公式
                                    Case "0"
                                        numI = numI + 1
                                    Case "1"
                                        For numRow = 2 To Cell1.Rows
                                            strTemp = Chr(97 + numI) & Trim(Str(numRow + 1)) & "+" & Chr(97 + numI + 1) & Trim(Str(numRow + 1))
'                                           计算公式，如“A2+B2”，其中“A”（chr(97)）为列编号，“2”为行编号
                                            Cell1.DoSetFormula numI + 2, numRow, strTemp
                                        Next
                                        numI = numI + 3
                                    Case "2"
                                        numI = numI + 1
                                    Case "3"
                                        For numRow = 2 To Cell1.Rows
                                            Cell1.DoSetDroplistCell numI, numRow, strtemp1, True, True
'                                           考查成绩按下拉列表形式输入
                                        Next
                                        numI = numI + 1
                                End Select
                            End If
                        Next
                        Cell1.DoMoveToCell 2, 2
'                       光标定位到第一个学生的第一个成绩位置
                        Command2.Enabled = True
                    End If
                Else
'               已经录入过成绩，显示相关信息
                    numRow = 2
                    Do While Not objRs1.EOF
                        Cell1.DoAppendRow 1
                        Cell1.DoSetCellString 0, numRow, Trim(objRs1("xh"))
                        Cell1.DoSetCellReadOnly 0, numRow, True
                        Cell1.DoSetCellString 1, numRow, Trim(fGetXm(objRs1("xh")))
                        Cell1.DoSetCellReadOnly 1, numRow, True
                        numcol = 2
                        For numI = 1 To 10
                            If objRs("kcbh" & Trim(Str(numI))) <> "" Then
                                Select Case Trim(objRs("pffs" & Trim(Str(numI))))
'                               根据评分方式的不同，显示不同形式的成绩值
                                    Case "0"
'                                   总成绩型，直接显示
                                        If objRs1("zcj" & Trim(Str(numI))) <> 0 Then
                                            Cell1.DoSetCellData numcol, numRow, objRs1("zcj" & Trim(Str(numI)))
                                        End If
                                    Case "1"
'                                   "理论成绩+实训成绩=总成绩"型
                                        If objRs1("llcj" & Trim(Str(numI))) <> 0 Then
                                            Cell1.DoSetCellData numcol, numRow, objRs1("llcj" & Trim(Str(numI)))
                                        End If
                                        If objRs1("sxcj" & Trim(Str(numI))) <> 0 Then
                                            Cell1.DoSetCellData numcol + 1, numRow, objRs1("sxcj" & Trim(Str(numI)))
                                        End If
                                        If objRs1("zcj" & Trim(Str(numI))) <> 0 Then
                                            Cell1.DoSetCellData numcol + 2, numRow, objRs1("zcj" & Trim(Str(numI)))
                                        Else
'                                       总成绩为空，设置计算公式（如“A2+B2”，“A”列为理论成绩，“B”列为实训成绩）
                                            strTemp = Chr(97 + numcol) & Trim(Str(numRow + 1)) & "+" & _
                                                Chr(97 + numcol + 1) & Trim(Str(numRow + 1))
                                            Cell1.DoSetFormula numcol + 2, numRow, strTemp
                                        End If
                                        numcol = numcol + 2
                                    Case "2"
                                        If objRs1("xf" & Trim(Str(numI))) <> 0 Then
                                            Cell1.DoSetCellData numcol, numRow, objRs1("xf" & Trim(Str(numI)))
                                        End If
                                    Case "3"
                                        If Trim(objRs1("kccj" & Trim(Str(numI)))) <> "" Then
                                            Cell1.DoSetDroplistCell numcol, numRow, strtemp1, True, True
                                            Cell1.DoSetCellString numcol, numRow, Trim(objRs1("kccj" & Trim(Str(numI))))
                                        Else
                                            Cell1.DoSetDroplistCell numcol, numRow, strtemp1, True, True
                                        End If
                                End Select
                                numcol = numcol + 1
                            End If
                        Next
                        numRow = numRow + 1
                        objRs1.MoveNext
                    Loop
                    Cell1.DoMoveToCell 2, 2
                    Command2.Enabled = True
'                   允许保存
                End If
                objRs1.Close
            Else
                MsgBox "指定条件的课程表还没有生成！", vbCritical, "错误信息"
                Command2.Enabled = False
            End If
            objRs.Close
        End If
    End If
End Sub

'***************************************************************************************
'  过程：Command2_Click
'  功能：保存录入或修改的成绩
'***************************************************************************************
Private Sub Command2_Click()
    Dim objRs1 As ADODB.Recordset
    Dim strExec As String
    Dim numI As Integer, numJ As Integer, numK As Integer
    If MsgBox("您确认保存本次录入的成绩吗？", vbYesNo, "系统信息") = vbYes Then
        pOpenProgressBar "正在保存数据", "正在保存数据，请稍候...", Cell1.Rows, FrmCjlr
'       调用pOpenProgressBar（定义于Module1模块内），打开进度条窗口
        strExec = "Select * From " & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text)
'       查询成绩表
        Set objRs = objCon.Execute(strExec)
        If objRs.EOF Then
'       第一次录入成绩
            strExec = "Insert Into " & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text) & " (XH) Select xh From XSDAB Where nj='" & Trim(Text1.Text) & "' And xbbh='" & _
                fGetXbbh(Combo1.Text) & "' And zybh='" & fGetZybh(Combo2.Text) & "'"
            objCon.Execute (strExec)
'           批量插入学号信息
        End If
        Set objRs1 = objCon.Execute("Select * From XKQKB Where kcbmc='" & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text) & "'")
        For numI = 2 To Cell1.Rows
            pSetProgressBarValue numI
'           每处理一行数据，进度条前进一步
            strExec = "Update " & fSckcbmc(Text1.Text, Combo1.Text, Combo2.Text, Combo5.Text) & " SET "
'           修改成绩表语句的头部，以下形成具体的列名和数据
            numK = 2
            For numJ = 1 To 10
                If objRs1("kcbh" & Trim(Str(numJ))) <> "" Then
                    Select Case objRs1("pffs" & Trim(Str(numJ)))
                        Case "0"
                            strExec = strExec & "zcj" & Trim(Str(numJ)) & "=" & Trim(Str(fGetCellData(numK, numI, Cell1))) & ","
                            numK = numK + 1
                        Case "1"
                            strExec = strExec & "llcj" & Trim(Str(numJ)) & "=" & Trim(Str(fGetCellData(numK, numI, Cell1))) & ","
                            strExec = strExec & "sxcj" & Trim(Str(numJ)) & "=" & Trim(Str(fGetCellData(numK + 1, numI, Cell1))) & ","
                            strExec = strExec & "zcj" & Trim(Str(numJ)) & "=" & Trim(Str(fGetCellData(numK + 2, numI, Cell1))) & ","
                            numK = numK + 3
                        Case "2"
                            strExec = strExec & "xf" & Trim(Str(numJ)) & "=" & Trim(Str(fGetCellData(numK, numI, Cell1))) & ","
                            numK = numK + 1
                        Case "3"
                            strExec = strExec & "kccj" & Trim(Str(numJ)) & "='" & Trim(fGetCellString(numK, numI, Cell1)) & "',"
                            numK = numK + 1
                    End Select
                End If
            Next
            strExec = Left(strExec, Len(strExec) - 1) & " Where xh='" & Trim(fGetCellString(0, numI, Cell1)) & "'"
            objCon.Execute (strExec)
'           执行Update语句，形成成绩数据
        Next
        bCellDataModified = False
'       保存完毕，数据修改标志置False
        pCloseProgressBar Cell1.Rows, FrmCjlr
'       进度条显示完毕，在pCloseProgressBar中自动关闭
        objRs.Close
        objRs1.Close
    End If
End Sub

'***************************************************************************************
'  过程：Form_Load
'  功能：窗体装入时进行初始化
'***************************************************************************************
Private Sub Form_Load()
    Set objRs = objCon.Execute("Select Distinct xbmc From XBMCB")
    Do While Not objRs.EOF
'   形成系别名称列表
        Combo1.AddItem Trim((objRs("xbmc")))
        objRs.MoveNext
    Loop
    Set objRs = objCon.Execute("Select Distinct zymc From ZYMCB")
    Do While Not objRs.EOF
'   形成专业名称列表
        Combo2.AddItem Trim((objRs("zymc")))
        objRs.MoveNext
    Loop
    objRs.Close
    Command1.Enabled = True
    Command2.Enabled = False
    Cell_Setup Cell1
End Sub

'***************************************************************************************
'  过程：Form_QueryUnload
'  功能：窗体关闭时恢复主窗口
'***************************************************************************************
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    bCellDataModified = False
    FrmMain.Enabled = True
End Sub

'***************************************************************************************
'  过程：Command3_Click
'  功能：“关闭”按钮按下时恢复主窗口
'***************************************************************************************
Private Sub Command3_Click()
    bCellDataModified = False
'   窗体关闭时清除数据修改标志
    FrmMain.Enabled = True
    Unload FrmCjlr
End Sub