frmcjpb.frm

毕业设计的学生成绩管理

                        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
                                    Cell1.DoSetCellReadOnly numcol, numRow, True
                                Case "1"
                                    If objRs1("llcj" & Trim(Str(numI))) <> 0 Then
                                        Cell1.DoSetCellData numcol, numRow, objRs1("llcj" & Trim(Str(numI)))
                                    End If
                                    Cell1.DoSetCellReadOnly numcol, numRow, True
                                    If objRs1("sxcj" & Trim(Str(numI))) <> 0 Then
                                        Cell1.DoSetCellData numcol + 1, numRow, objRs1("sxcj" & Trim(Str(numI)))
                                    End If
                                    Cell1.DoSetCellReadOnly numcol + 1, numRow, True
                                    If objRs1("zcj" & Trim(Str(numI))) <> 0 Then
                                        Cell1.DoSetCellData numcol + 2, numRow, objRs1("zcj" & Trim(Str(numI)))
                                    End If
                                    Cell1.DoSetCellReadOnly numcol + 2, numRow, True
                                    numcol = numcol + 2
                                Case "2"
                                    If objRs1("xf" & Trim(Str(numI))) <> 0 Then
                                        Cell1.DoSetCellData numcol, numRow, objRs1("xf" & Trim(Str(numI)))
                                    End If
                                    Cell1.DoSetCellReadOnly numcol, numRow, True
                                Case "3"
                                    If Trim(objRs1("kccj" & Trim(Str(numI)))) <> "" Then
                                        Cell1.DoSetCellString numcol, numRow, Trim(objRs1("kccj" & Trim(Str(numI))))
                                    End If
                                    Cell1.DoSetCellReadOnly numcol, numRow, True
                            End Select
                            numcol = numcol + 1
                        End If
                    Next
                    numRow = numRow + 1
                    objRs1.MoveNext
                Loop
                
                Set objRs2 = objCon.Execute("Select * From XTCSB Where lb=1")
'               从系统参数表获取考查课成绩信息（“优秀”、“良好”、“及格”等，由“lb=1”指示）
                If objRs2.EOF Then
                    MsgBox "考查课成绩类型没有定义，请重新设置系统！", vbCritical, "错误信息"
                    Exit Sub
                End If
                For numRow = 2 To Cell1.Rows
                    numcol = 2
                    fHjcj = 0
'                   合计成绩
                    numCjgs = 0
'                   成绩个数，用于计算平均成绩
                    For numI = 1 To 10
                        If objRs("kcbh" & Trim(Str(numI))) <> "" Then
                            Select Case Trim(objRs("pffs" & Trim(Str(numI))))
'                           根据评分方式的不同，计算不同形式的成绩
                                Case "0"
'                               总成绩型，直接取成绩
                                    btemp = Cell1.DoGetCellData(numcol, numRow, vTemp)
                                    fHjcj = fHjcj + vTemp
                                    numCjgs = numCjgs + 1
                                    numcol = numcol + 1
                                Case "1"
'                               "理论成绩+实训成绩=总成绩"型，取总成绩
                                    btemp = Cell1.DoGetCellData(numcol + 2, numRow, vTemp)
                                    fHjcj = fHjcj + vTemp
                                    numCjgs = numCjgs + 1
                                    numcol = numcol + 3
                                Case "2"
'                               学分成绩不计入总成绩，所以成绩个数不增加
'                                   numCjgs = numCjgs + 1
                                    numcol = numcol + 1
                                Case "3"
'                               考查成绩，根据考查成绩的计分方法（在系统参数表中定义）计算成绩
                                    btemp = Cell1.DoGetCellData(numcol, numRow, vTemp)
                                    objRs2.MoveFirst
                                    Do While Not objRs2.EOF
                                        If Trim(objRs2("mc")) = Trim(vTemp) Then
'                                       考查成绩名称相符，取对应的数值（“sz”）为实际成绩
                                            fHjcj = fHjcj + objRs2("sz")
                                            Exit Do
                                        End If
                                        objRs2.MoveNext
                                    Loop
                                    numCjgs = numCjgs + 1
                                    numcol = numcol + 1
                            End Select
                        End If
                    Next
                    Cell1.DoSetCellData numColHjcj, numRow, fHjcj
'                   合计成绩
                    Cell1.DoSetCellReadOnly numColHjcj, numRow, True
                    Cell1.DoSetCellData numColPjcj, numRow, Round(fHjcj / numCjgs, 2)
'                   平均成绩
                    Cell1.DoSetCellReadOnly numColPjcj, numRow, True
                Next
                objRs2.Close
                
                For numRow = 3 To Cell1.Rows + 1
'               形成总成绩公式
                    strZcjGs = Chr(97 + numColPjcj) & Trim(Str(numRow))
                    For numI = numColPjcj + 2 To Cell1.Cols - 3
                        strZcjGs = strZcjGs + "+" & Chr(97 + numI) & Trim(Str(numRow))
                    Next
                    Cell1.DoSetFormula numColZcj, numRow - 1, strZcjGs
'                   设置每一行的总成绩公式
                    btemp = Cell1.DoGetCellData(numColZcj, numRow - 1, vTemp)
                    If CInt(vTemp) <> vTemp Then
'                   如果总成绩为浮点型，保留小数点后两位
                        Cell1.DoSetCellNumberStyle numColZcj, numRow - 1, 0, False, 2, -1, False, 0, False
                    End If
                    Cell1.DoSetCellReadOnly numColZcj, numRow - 1, True
                Next
                Command2.Enabled = True
'               允许排榜
                Command4.Enabled = True
'               允许打印
            End If
            objRs1.Close
        Else
            MsgBox "指定条件的课程表还没有生成！", vbCritical, "错误信息"
            Command2.Enabled = False
'           不允许排榜
            Command4.Enabled = False
'           不允许打印
        End If
        objRs.Close
    End If
End Sub

'***************************************************************************************
'  过程：MySort
'  功能：排榜
'  参数：
'       numColVal：排榜依据，如平均成绩、总成绩
'       numColNo：排榜榜次的显示位置
'***************************************************************************************
Private Sub MySort(ByVal numColVal As Integer, ByVal numColNo)
    Dim numI As Integer, numMaxRow As Integer, numRows As Integer, numRemainRows As Integer, numJ As Integer
    Dim numNo As Integer, numDupNo As Integer, numType As Integer
    Dim btemp As Boolean
    Dim vTemp As Variant, vMax As Variant, vLastMax As Variant
    numRows = Cell1.Rows - 1
'   总行数
    numRemainRows = numRows
'   剩余行数
    numNo = 0
'   排榜名次
    vLastMax = 0
'   上次的最高成绩
    numDupNo = 0
'   重复名次个数，用于计算重复名次后的新名次，如三个第3，则下一个名次为6
    For numI = 2 To numRows
        vMax = 0
        For numJ = 2 To numRemainRows
'       查找最高成绩，记忆其行号
            btemp = Cell1.DoGetCellData(numColVal, numJ, vTemp)
            If vTemp >= vMax Then
                vMax = vTemp
                numMaxRow = numJ
            End If
        Next
        If vMax <> vLastMax Then
'       当前最高成绩和上次的最高成绩不相等，排榜名次为“排榜名次+重复名次个数+1”
            numNo = numNo + numDupNo + 1
            numDupNo = 0
        Else
'       当前最高成绩和上次的最高成绩相等，重复名次个数加1
            numDupNo = numDupNo + 1
        End If
        Cell1.DoSetCellData numColNo, numMaxRow, numNo
'       设置名次值
        vLastMax = vMax
'       保存本次最高成绩
        Cell1.DoAppendRow 1
'       将本次行移到添加的新行，达到排序效果
        For numJ = 0 To Cell1.Cols - 1
            btemp = Cell1.DoGetCellData(numJ, numMaxRow, vTemp)
            numType = Cell1.DoGetCellDataType(numJ, numMaxRow)
            If numType = 1 Then
'           string型数据
                Cell1.DoSetCellString numJ, Cell1.Rows - 1, vTemp
            ElseIf numType = 2 Then
'           数值型数据
                If CInt(vTemp) <> vTemp Then
                    Cell1.DoSetCellNumberStyle numJ, Cell1.Rows - 1, 0, False, 2, -1, False, 0, False
                End If
                Cell1.DoSetCellData numJ, Cell1.Rows - 1, vTemp
            End If
            Cell1.DoSetCellReadOnly numJ, Cell1.Rows - 1, True
        Next
        Cell1.DoDeleteRow numMaxRow, 1
'       删除原行
        numRemainRows = numRemainRows - 1
'       未排榜行数减1
    Next
End Sub

'***************************************************************************************
'  过程：Command2_Click
'  功能：成绩排榜，按合计成绩和总成绩（平均成绩+附加分）排榜两次
'***************************************************************************************
Private Sub Command2_Click()
    MySort numColHjcj, numColCjbc
    MySort numColZcj, numColZbc
End Sub

'***************************************************************************************
'  过程：Command4_Click
'  功能：成绩打印
'***************************************************************************************
Private Sub Command4_Click()
    MsgBox "请在打印机中放入A3或宽行打印纸...", vbOKOnly, "数据打印"
    Load FrmPrePrint
    FrmPrePrint.Cell1.DoSetDefaultFont 8, 0, "宋体"
'   调入打印预览窗口
    Cell1.DoCopyArea 0, 0, Cell1.Cols - 1, Cell1.Rows - 1
'   复制数据到剪贴板中
    FrmPrePrint.Cell1.DoPaste 0, 0, True
'   粘贴数据到打印窗口中
    FrmPrePrint.Cell1.Cols = Cell1.Cols
    FrmPrePrint.Cell1.Rows = Cell1.Rows
    
'   设置报表标题
    FrmPrePrint.Cell1.DoInsertRow 0, 1
    FrmPrePrint.Cell1.DoJoinCells 0, 0, FrmPrePrint.Cell1.Cols - 1, 0
    FrmPrePrint.Cell1.DoSetRowHeight 0, 60
    FrmPrePrint.Cell1.DoSetCellFont 0, 0, 12, 1, "宋体"         '12号宋体字，粗体
    FrmPrePrint.Cell1.DoSetCellString 0, 0, Trim(Combo1.Text) & Trim(Text1.Text) & "级" & IIf(Len(Text2.Text) = 0, "", Trim(Text2.Text) & "班") & "第" & Trim(Combo5.Text) & "学期成绩总榜"
    FrmPrePrint.Cell1.DoSetCellAlignment 0, 0, 36
'   设置页脚：页号 日期
    FrmPrePrint.Cell1.DoSetPrintFoot "", "&P   &D", ""
'   显示网格
    FrmPrePrint.Cell1.DoDrawLine 0, 1, FrmPrePrint.Cell1.Cols, FrmPrePrint.Cell1.Rows, 0, 1, 0
    FrmPrePrint.Cell1.DoSetPrintPara 1, 8, False
    FrmPrePrint.Cell1.DoPrintPreview True
    Unload FrmPrePrint
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
'   初始阶段不允许使用“排榜”按钮
    Command4.Enabled = False
'   初始阶段不允许使用“打印”按钮
    Cell_Setup Cell1
End Sub

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

'***************************************************************************************
'  过程：Command3_Click
'  功能：“关闭”按钮按下时恢复主窗口
'***************************************************************************************
Private Sub Command3_Click()
    FrmMain.Enabled = True
    Unload FrmCjpb
End Sub