gzl_tj.frm

这是一个非常 好的一个程序进行体会一下学生管理系统

    Set xlApp = Nothing '交还控制给Excel
End Sub

Private Sub Command_dc2_Click() '计算结果导出（科研工作量）
    On Error Resume Next
    Dim colnum, rownum As Integer '存字段数量,记录书
    Dim row As Integer  '用来记录excel表的当前行
    Dim Fieldlen() '存字段长度值
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    colnum = kyFlexGrid.Cols
    rownum = kyFlexGrid.Rows
    ReDim Fieldlen(colnum)
    '往表内写入标题
    xlSheet.Cells(1, 2).Value = "科研工作量计算结果表 "
    xlSheet.Cells(3, 1).Value = "学期：" & Trim(Text2.Text)
    'xlSheet.Cells(3, 2).Value = Trim(Text2.Text)
    xlSheet.Cells(3, 3).Value = "教师姓名："
    xlSheet.Cells(3, 4).Value = Trim(Combo2.Text)
    '往表内写入字段名
    For i = 0 To colnum - 1
        xlSheet.Cells(4, i + 1).Value = kyFlexGrid.TextMatrix(0, i)
        Fieldlen(i) = LenB(kyFlexGrid.TextMatrix(0, i))
    Next i
    '开始往表内写查询结果
    row = 5
    For j = 1 To rownum - 1
        For i = 0 To colnum - 1
            If IsNull(kyFlexGrid.TextMatrix(row - 4, i)) = False Then
                xlSheet.Cells(row, i + 1).Value = kyFlexGrid.TextMatrix(row - 4, i)
                If LenB(kyFlexGrid.TextMatrix(row - 4, i)) > Fieldlen(i) Then '将字段的最大长度保存在Fieldlen()数组中
                    Fieldlen(i) = LenB(kyFlexGrid.TextMatrix(row - 4, i))
                    xlSheet.Columns(i + 1).ColumnWidth = Fieldlen(i)
                End If
            End If
        Next i
        mrc.MoveNext
        row = row + 1
    Next j
    With xlSheet
        .Cells(1, 2).Font.Name = "黑体" '设标题为黑体字
        .Cells(1, 2).Font.Size = 24   '标题字体大小为24
        .Range(.Cells(4, 1), .Cells(row - 1, colnum)).Borders.LineStyle = xlContinuous
        '设表格边框样式
    End With
    xlApp.Visible = True '显示表格
    xlBook.Save '保存'
    Set xlApp = Nothing '交还控制给Excel
End Sub

Private Sub Command_dc3_Click() '导出按钮（总工作量计算）
    On Error Resume Next
    Dim colnum, rownum As Integer '存字段数量,记录书
    Dim row As Integer  '用来记录excel表的当前行
    Dim Fieldlen() '存字段长度值
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)
    colnum = zjFlexGrid.Cols
    rownum = zjFlexGrid.Rows
    ReDim Fieldlen(colnum)
    '往表内写入标题
    xlSheet.Cells(1, 2).Value = "总工作量计算结果表 "
    xlSheet.Cells(3, 1).Value = "学期：" & Trim(Text3.Text)
    'xlSheet.Cells(3, 2).Value = Trim(Text3.Text)
    xlSheet.Cells(3, 3).Value = "教师姓名："
    xlSheet.Cells(3, 4).Value = Trim(Combo3.Text)
    '往表内写入字段名
    For i = 0 To colnum - 1
        xlSheet.Cells(4, i + 1).Value = zjFlexGrid.TextMatrix(0, i)
        Fieldlen(i) = LenB(zjFlexGrid.TextMatrix(0, i))
    Next i
    '开始往表内写查询结果
    row = 5
    For j = 1 To rownum - 1
        For i = 0 To colnum - 1
            If IsNull(zjFlexGrid.TextMatrix(row - 4, i)) = False Then
                xlSheet.Cells(row, i + 1).Value = zjFlexGrid.TextMatrix(row - 4, i)
                If LenB(zjFlexGrid.TextMatrix(row - 4, i)) > Fieldlen(i) Then '将字段的最大长度保存在Fieldlen()数组中
                    Fieldlen(i) = LenB(zjFlexGrid.TextMatrix(row - 4, i))
                    xlSheet.Columns(i + 1).ColumnWidth = Fieldlen(i)
                End If
            End If
        Next i
        mrc.MoveNext
        row = row + 1
    Next j
    With xlSheet
        .Cells(1, 2).Font.Name = "黑体" '设标题为黑体字
        .Cells(1, 2).Font.Size = 24   '标题字体大小为24
        .Range(.Cells(4, 1), .Cells(row - 1, colnum)).Borders.LineStyle = xlContinuous
        '设表格边框样式
    End With
    xlApp.Visible = True '显示表格
    xlBook.Save '保存'
    Set xlApp = Nothing '交还控制给Excel
End Sub

Private Sub Command1_Click() ' 确定按钮（计算教学工作量）
    If Text1.Text = "" Then
        MsgBox "请输入学期！", 0 + 48, "注意！"
        Text1.SetFocus
        Exit Sub
    End If
    If Not IsNumeric(Text1.Text) Then
        MsgBox "输入的学期格式不对！", 0 + 48, "注意！"
        Text1.SetFocus
        SendKeys "{home}+{end}"
        Exit Sub
    End If
    If Combo1.Text = "" Then
        MsgBox "请选择教师姓名！", 0 + 48, "注意！"
        Combo1.SetFocus
        Exit Sub
    End If
    
    Dim tno, cno As String '用来保存所选教师的职工号和课程号
    Dim sum As Single  '用来保存工作量之和
    sum = 0
    SQL = "select Tea_id from Tea_info where Tea_name = " & "'" & Trim(Combo1.Text) & "'"
    Set mrc = ExecuteSQL(SQL, MsgText)
    tno = mrc.Fields(0)
    mrc.Close
    SQL = "select * from quanti_info where Tea_id = " & "'" & tno & "'" & _
          " and term = " & "'" & Trim(Text1.Text) & "'"
    Set mrc = ExecuteSQL(SQL, MsgText)
    If mrc.EOF Then
        mrc.AddNew
        mrc.Fields(0) = Trim(Text1.Text)
        mrc.Fields(1) = tno
    End If
    With jxFlexGrid
        .Rows = 1
        Set mrc1 = New ADODB.Recordset
        '查询本专科授课表（bzhk_info）
        sql1 = "select Cou_name,class,class_hour from Cou_info,bzhk_info where  " & _
               " Cou_info.Cou_no=bzhk_info.Cou_no and Tea_id = " & "'" & tno & "'" & _
               " and term = " & "'" & Trim(Text1.Text) & "'"
        Set mrc1 = ExecuteSQL(sql1, MsgText)
        While Not mrc1.EOF
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = "本专科授课"
            For i = 0 To 2
                If Not IsNull(mrc1.Fields(i)) Then
                    .TextMatrix(.Rows - 1, i + 1) = mrc1.Fields(i)
                End If
            Next i
            If Not IsNull(mrc1.Fields(2)) Then
                sum = sum + mrc1.Fields(2)
            End If
            mrc1.MoveNext
        Wend
        mrc1.Close
        
        '查询研究生授课表（yjsh_info）
        sql1 = "select Cou_name,class,class_hour from Cou_info, yjsh_info where  " & _
               " Cou_info.Cou_no=yjsh_info.Cou_no and Tea_id = " & "'" & tno & "'" & _
               " and term = " & "'" & Trim(Text1.Text) & "'"
        Set mrc1 = ExecuteSQL(sql1, MsgText)
        While Not mrc1.EOF
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = "研究生授课"
            For i = 0 To 2
                If Not IsNull(mrc1.Fields(i)) Then
                    .TextMatrix(.Rows - 1, i + 1) = mrc1.Fields(i)
                End If
            Next i
            If Not IsNull(mrc1.Fields(2)) Then
                sum = sum + mrc1.Fields(2)
            End If
            mrc1.MoveNext
        Wend
        mrc1.Close
        
        '查询实验与上机表（shyshj_info）
        sql1 = "select Cou_name,class,class_hour from Cou_info ,shyshj_info where  " & _
               " Cou_info.Cou_no=shyshj_info.Cou_no and Tea_id = " & "'" & tno & "'" & _
               " and term = " & "'" & Trim(Text1.Text) & "'"
        Set mrc1 = ExecuteSQL(sql1, MsgText)
        While Not mrc1.EOF
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = "指导实验与上机"
            For i = 0 To 2
                If Not IsNull(mrc1.Fields(i)) Then
                    .TextMatrix(.Rows - 1, i + 1) = mrc1.Fields(i)
                End If
            Next i
            If Not IsNull(mrc1.Fields(2)) Then
                sum = sum + mrc1.Fields(2)
            End If
            mrc1.MoveNext
        Wend
        mrc1.Close
        
        '查询生产实习表（shchshx_info）
        sql1 = "select class,class_hour from  shchshx_info where  " & _
               "  Tea_id = " & "'" & tno & "'" & _
               " and term = " & "'" & Trim(Text1.Text) & "'"
        Set mrc1 = ExecuteSQL(sql1, MsgText)
        While Not mrc1.EOF
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = "指导生产实习"
            .TextMatrix(.Rows - 1, 1) = "生产实习"
            For i = 0 To 1
                If Not IsNull(mrc1.Fields(i)) Then
                    .TextMatrix(.Rows - 1, i + 2) = mrc1.Fields(i)
                End If
            Next i
            If Not IsNull(mrc1.Fields(1)) Then
                sum = sum + mrc1.Fields(1)
            End If
            mrc1.MoveNext
        Wend
        mrc1.Close
        
         '查询毕业设计表（bishe_info）
        sql1 = "select Stu_num,class_hour from  bishe_info where  " & _
               "  Tea_id = " & "'" & tno & "'" & _
               " and term = " & "'" & Trim(Text1.Text) & "'"
        Set mrc1 = ExecuteSQL(sql1, MsgText)
        While Not mrc1.EOF
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = "指导毕业设计"
            .TextMatrix(.Rows - 1, 1) = "毕业设计"
            .TextMatrix(.Rows - 1, 2) = "学生数:" & mrc1.Fields(0)
            If Not IsNull(mrc1.Fields(1)) Then
                .TextMatrix(.Rows - 1, 3) = mrc1.Fields(1)
                sum = sum + mrc1.Fields(1)
            End If
            mrc1.MoveNext
        Wend
        mrc1.Close
        
         '查询课程设计表（kchshj_info）
        sql1 = "select Cou_name,class,class_hour from Cou_info, kchshj_info where  " & _
               " Cou_info.Cou_no=kchshj_info.Cou_no and Tea_id = " & "'" & tno & "'" & _
               " and term = " & "'" & Trim(Text1.Text) & "'"
        Set mrc1 = ExecuteSQL(sql1, MsgText)
        While Not mrc1.EOF
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = "指导课程设计"
            For i = 0 To 2
                If Not IsNull(mrc1.Fields(i)) Then
                    .TextMatrix(.Rows - 1, i + 1) = mrc1.Fields(i)
                End If
            Next i
            If Not IsNull(mrc1.Fields(2)) Then
                sum = sum + mrc1.Fields(2)
            End If
            mrc1.MoveNext
        Wend
        mrc1.Close
        
         '查询指导学位研究生表（xwyjsh_info）
        sql1 = "select Stu_id,class_hour from  xwyjsh_info where  " & _
               "  Tea_id = " & "'" & tno & "'" & _
               " and term = " & "'" & Trim(Text1.Text) & "'"
        Set mrc1 = ExecuteSQL(sql1, MsgText)
        While Not mrc1.EOF
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = "指导学位研究生"
            .TextMatrix(.Rows - 1, 1) = "研究生"
            .TextMatrix(.Rows - 1, 2) = "学生学号:" & mrc1.Fields(0)
            If Not IsNull(mrc1.Fields(1)) Then
                .TextMatrix(.Rows - 1, 3) = mrc1.Fields(1)
                sum = sum + mrc1.Fields(1)
            End If
            mrc1.MoveNext
        Wend
        mrc1.Close
        Set mrc1 = Nothing
        If .Rows = 1 Then
            MsgBox "没有" & Trim(Combo1.Text) & "老师在" & Trim(Text1.Text) & "学期的教学工作记录！", 0 + 48, "注意！"
            Text1.SetFocus
            SendKeys "{home}+{end}"
            Exit Sub
        End If
        .Rows = .Rows + 1
        .TextMatrix(.Rows - 1, 0) = "总计："
        .TextMatrix(.Rows - 1, 1) = sum
    End With
    mrc.Fields(2) = sum
    mrc.Update
    mrc.Close
    Set mrc = Nothing
    Command1.Enabled = False
    Command2.Enabled = True
    Command_dc1.Enabled = True
End Sub

Private Sub Command2_Click() '重置按钮（计算教学工作量）
    jxFlexGrid.Rows = 1
    Text1.Text = ""
    Combo1.Text = ""
    Command1.Enabled = True
    Command_dc1.Enabled = False
    Command2.Enabled = False
End Sub

Private Sub Command3_Click() '重置按钮（科研工作量计算）
    kyFlexGrid.Rows = 1
    Text2.Text = ""
    Combo2.Text = ""
    Command4.Enabled = True
    Command_dc2.Enabled = False
    Command3.Enabled = False
End Sub

Private Sub Command4_Click() '确定按钮（计算科研工作量）
    If Text2.Text = "" Then
        MsgBox "请输入学期！", 0 + 48, "注意！"
        Text2.SetFocus
        Exit Sub
    End If
    If Not IsNumeric(Text2.Text) Then
        MsgBox "输入的学期格式不对！", 0 + 48, "注意！"
        Text2.SetFocus
        SendKeys "{home}+{end}"
        Exit Sub
    End If
    If Combo2.Text = "" Then
        MsgBox "请选择教师姓名！", 0 + 48, "注意！"
        Combo2.SetFocus
        Exit Sub
    End If
    
    Dim tno, cno As String '用来保存所选教师的职工号和课程号
    Dim sum As Single  '用来保存工作量之和
    sum = 0
    Set mrc = New ADODB.Recordset
    SQL = "select Tea_id from Tea_info where Tea_name = " & "'" & Trim(Combo2.Text) & "'"
    Set mrc = ExecuteSQL(SQL, MsgText)
    tno = mrc.Fields(0)
    mrc.Close
    SQL = "select * from quanti_info where Tea_id = " & "'" & tno & "'" & _
          " and term = " & "'" & Trim(Text2.Text) & "'"
    Set mrc = ExecuteSQL(SQL, MsgText)
    If mrc.EOF Then
        mrc.AddNew
        mrc.Fields(0) = Trim(Text2.Text)
        mrc.Fields(1) = tno
    End If
    With kyFlexGrid
        .Rows = 1
                
        '查询科研课题与经费表（kyktjf_info）
        sql1 = "select title,equival from kyktjf_info where  " & _
               " Tea_id = " & "'" & tno & "'" & _
               " and term = " & "'" & Trim(Text2.Text) & "'"
        Set mrc1 = ExecuteSQL(sql1, MsgText)
        While Not mrc1.EOF
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = "科研课题与经费"
            For i = 0 To 1
                If Not IsNull(mrc1.Fields(i)) Then
                    .TextMatrix(.Rows - 1, i + 1) = mrc1.Fields(i)
                End If
            Next i
            If Not IsNull(mrc1.Fields(1)) Then
                .TextMatrix(.Rows - 1, 3) = mrc1.Fields(1) * 30
                sum = sum + mrc1.Fields(1) * 30
            End If
            mrc1.MoveNext
        Wend
        mrc1.Close
        
        '查询科研成果表（kychg_info）
        sql1 = "select title,equival from kychg_info where  " & _
               " Tea_id = " & "'" & tno & "'" & _
               " and term = " & "'" & Trim(Text2.Text) & "'"
        Set mrc1 = ExecuteSQL(sql1, MsgText)
        While Not mrc1.EOF
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = "科研成果"
            For i = 0 To 1
                If Not IsNull(mrc1.Fields(i)) Then
                    .TextMatrix(.Rows - 1, i + 1) = mrc1.Fields(i)
                End If
            Next i
            If Not IsNull(mrc1.Fields(1)) Then
                .TextMatrix(.Rows - 1, 3) = mrc1.Fields(1) * 30
                sum = sum + mrc1.Fields(1) * 30
            End If
            mrc1.MoveNext
        Wend
        mrc1.Close
        
        '查询论文表（lunwen_info）
        sql1 = "select title,equival from lunwen_info where  " & _
               " Tea_id = " & "'" & tno & "'" & _
               " and term = " & "'" & Trim(Text2.Text) & "'"
        Set mrc1 = ExecuteSQL(sql1, MsgText)
        While Not mrc1.EOF
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = "发表论文"
            For i = 0 To 1
                If Not IsNull(mrc1.Fields(i)) Then
                    .TextMatrix(.Rows - 1, i + 1) = mrc1.Fields(i)
                End If
            Next i
            If Not IsNull(mrc1.Fields(1)) Then
                .TextMatrix(.Rows - 1, 3) = mrc1.Fields(1) * 30
                sum = sum + mrc1.Fields(1) * 30
            End If