cls_report.cls

学生学籍管理系统

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Cls_Report"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
Option Explicit

Private MyExcel   As Excel.Application   '声明,引用中加上Microsoft Excel 9.0 Object Library
Private mysheet As Worksheet           '声明工作表
'Private mybook As Workbook             '声明工作簿
Private ModelWorkbook As Workbooks
Private mycnt As Cls_Connect
Dim myqry As Cls_Connect
Private mygrade As Cls_Grade

Private Sub Class_Initialize()
Set MyExcel = New Excel.Application  '声明实体

End Sub

Public Function StudentReport(myclassid As String)
'打印学生信息报表
Dim i, j As Integer
Set mycnt = New Cls_Connect
mycnt.QryName = "select StudentID,StudentName,Birthday,IDcard,Study1,Specialty,Tel1,Sex,Fee,Status from StudentInfo where ClassID='" & myclassid & "'"
mycnt.openQry
If mycnt.MQueryRs.EOF = False Then
    Set ModelWorkbook = MyExcel.Workbooks
    ModelWorkbook.Open App.Path & "\学生信息报表.xlt", 1
    Set mysheet = MyExcel.Sheets(1)
    mysheet.Activate
    
    For i = 0 To mycnt.MQueryRs.RecordCount - 1
        For j = 0 To mycnt.MQueryRs.Fields.Count - 1
            If mycnt.MQueryRs.Fields(j) <> Empty Then
               mysheet.Cells(i + 3, j + 1).Value = CStr(Trim(mycnt.MQueryRs.Fields(j))) '写入Excel表
            Else
               mysheet.Cells(i + 3, j + 1).Value = "无"
            End If
        Next
    mycnt.MQueryRs.MoveNext
    Next
    MyExcel.Visible = True
    'mysheet.SaveAs " E:\SIMS\事务规则服务器\学生信息报表.xls"
    Set mycnt = Nothing
Else
   MsgBox "无符合的信息！请重新输入！"
End If
End Function

Public Function MarkReport(myclassid As String, mycourseid As String, myexanmkind As String, myarea As String, myvalue As String)
'打印各个学期、班级、考试种类、以及分数范围限制的报表表单
Dim i, j As Integer
Set mygrade = New Cls_Grade
If myexanmkind = "" And myarea = "" And myvalue = "" Then
    mygrade.PrcGradeStat myclassid
    If mygrade.GetGrade.EOF = False Then
            Set ModelWorkbook = MyExcel.Workbooks
            ModelWorkbook.Open App.Path & "\班级科目成绩报表.xlt", 1
            Set mysheet = MyExcel.Sheets(1)
            mysheet.Activate
        i = 0
        Do Until mygrade.GetGrade.EOF
           If mycourseid = Trim(mygrade.GetGrade.Fields(1)) Then
              For j = 0 To mygrade.GetGrade.Fields.Count - 1
                   mysheet.Cells(i + 3, j + 1).Value = CStr(Trim(mygrade.GetGrade.Fields(j)))
              Next
               i = i + 1
           End If
           mygrade.GetGrade.MoveNext
          Loop
          MyExcel.Visible = True
            'mysheet.SaveAs " E:\SIMS\事务规则服务器\学生信息报表.xls"
          Set mygrade = Nothing
   
    Else
       MsgBox "无符合的信息！请重新输入！"
    End If
ElseIf myexanmkind <> "" And myarea = "" And myvalue = "" Then
   Set myqry = New Cls_Connect
   myqry.QryName = "select Gradeinfo.StudentID,Gradeinfo.CourseID," & myexanmkind & " from GradeInfo inner join Studentinfo on Gradeinfo.StudentID=StudentInfo.StudentID  where  ClassID='" & myclassid & "'and CourseID='" & mycourseid & "'"
   myqry.openQry
    If myqry.MQueryRs.EOF = False Then
        Set ModelWorkbook = MyExcel.Workbooks
        ModelWorkbook.Open App.Path & "\单科课程成绩报表.xlt", 1
        Set mysheet = MyExcel.Sheets(1)
        mysheet.Activate
            If Trim(myqry.MQueryRs.Fields(2).Name) = "GradeCpt" Then
               mysheet.Cells(2, 3).Value = "机试成绩"
            ElseIf Trim(myqry.MQueryRs.Fields(2).Name) = "GradeUal" Then
               mysheet.Cells(2, 3).Value = "平时成绩"
            ElseIf Trim(myqry.MQueryRs.Fields(2).Name) = "GradePaper" Then
               mysheet.Cells(2, 3).Value = "笔试成绩"
            End If
        For i = 0 To myqry.MQueryRs.RecordCount - 1
            For j = 0 To myqry.MQueryRs.Fields.Count - 1
                If myqry.MQueryRs.Fields(j) <> Empty Then
                   mysheet.Cells(i + 3, j + 1).Value = CStr(Trim(myqry.MQueryRs.Fields(j))) '写入Excel表
                Else
                   mysheet.Cells(i + 3, j + 1).Value = "无"
                End If
            Next
        myqry.MQueryRs.MoveNext
        Next
        MyExcel.Visible = True
        'mysheet.SaveAs " E:\SIMS\事务规则服务器\学生信息报表.xls"
        Set myqry = Nothing
    Else
       MsgBox "无符合的信息！请重新输入！"
    End If

ElseIf myexanmkind = "" And myarea <> "" And myvalue <> "" Then
   Set myqry = New Cls_Connect
   myqry.QryName = "select GradeInfo.StudentID,GradeInfo.CourseID,GradeCpt,GradeUal,GradePaper from GradeInfo inner join StudentInfo on GradeInfo.StudentID=StudentInfo.StudentID where CourseID='" & mycourseid & "' And GradeCpt" & myarea & myvalue & " And GradeUal " & myarea & myvalue & " And GradePaper " & myarea & myvalue & ""
   myqry.openQry
    If myqry.MQueryRs.EOF = False Then
        Set ModelWorkbook = MyExcel.Workbooks
        ModelWorkbook.Open App.Path & "\班级科目成绩报表.xlt", 1
        Set mysheet = MyExcel.Sheets(1)
        mysheet.Activate

        For i = 0 To myqry.MQueryRs.RecordCount - 1
            For j = 0 To myqry.MQueryRs.Fields.Count - 1
                If myqry.MQueryRs.Fields(j) <> Empty Then
                   mysheet.Cells(i + 3, j + 1).Value = CStr(Trim(myqry.MQueryRs.Fields(j))) '写入Excel表
                Else
                   mysheet.Cells(i + 3, j + 1).Value = "无"
                End If
            Next
        myqry.MQueryRs.MoveNext
        Next
        MyExcel.Visible = True
        'mysheet.SaveAs " E:\SIMS\事务规则服务器\学生信息报表.xls"
        Set myqry = Nothing
    Else
       MsgBox "无符合的信息！请重新输入！"
    End If
ElseIf myexanmkind <> "" And myarea <> "" And myvalue <> "" Then
   Set myqry = New Cls_Connect
   myqry.QryName = "select Gradeinfo.StudentID,Gradeinfo.CourseID," & myexanmkind & " from GradeInfo inner join Studentinfo on Gradeinfo.StudentID=StudentInfo.StudentID  where  ClassID='" & myclassid & "'and CourseID='" & mycourseid & "'And " & myexanmkind & myarea & myvalue & ""
   myqry.openQry
    If myqry.MQueryRs.EOF = False Then
        Set ModelWorkbook = MyExcel.Workbooks
        ModelWorkbook.Open App.Path & "\单科课程成绩报表.xlt", 1
        Set mysheet = MyExcel.Sheets(1)
        mysheet.Activate
        If Trim(myqry.MQueryRs.Fields(2).Name) = "GradeCpt" Then
               mysheet.Cells(2, 3).Value = "机试成绩"
            ElseIf Trim(myqry.MQueryRs.Fields(2).Name) = "GradeUal" Then
               mysheet.Cells(2, 3).Value = "平时成绩"
            ElseIf Trim(myqry.MQueryRs.Fields(2).Name) = "GradePaper" Then
               mysheet.Cells(2, 3).Value = "笔试成绩"
            End If
        For i = 0 To myqry.MQueryRs.RecordCount - 1
            For j = 0 To myqry.MQueryRs.Fields.Count - 1
                If myqry.MQueryRs.Fields(j) <> Empty Then
                   mysheet.Cells(i + 3, j + 1).Value = CStr(Trim(myqry.MQueryRs.Fields(j))) '写入Excel表
                Else
                   mysheet.Cells(i + 3, j + 1).Value = "无"
                End If
            Next
        myqry.MQueryRs.MoveNext
        Next
        MyExcel.Visible = True
        'mysheet.SaveAs " E:\SIMS\事务规则服务器\学生信息报表.xls"
        Set myqry = Nothing
    Else
       MsgBox "无符合的信息！请重新输入！"
    End If
End If
End Function

Public Function EnterForExamReport(mydate As String, myexanmkind As String, myclassid As String, mycourseid As String)
'打印各个学期、班级、考试种类、以及日期范围限制的考试报名报表
Dim i, j As Integer
Set myqry = New Cls_Connect
If mydate <> "" Then
    myqry.QryName = "select ExamInfo.ExamDate,ExamInfo.ExamKind,ExamInfo.StudentID,ExamInfo.CourseID from ExamInfo inner join StudentInfo on ExamInfo.StudentID=StudentInfo.StudentID where StudentInfo.ClassID='" & myclassid & "'and CourseId='" & mycourseid & "'and Examkind='" & myexanmkind & "'and ExamDate='" & mydate & "'"
     myqry.openQry
    If myqry.MQueryRs.EOF = False Then
        Set ModelWorkbook = MyExcel.Workbooks
        ModelWorkbook.Open App.Path & "\学生考试报表.xlt", 1
        Set mysheet = MyExcel.Sheets(1)
        mysheet.Activate
        
        For i = 0 To myqry.MQueryRs.RecordCount - 1
            For j = 0 To myqry.MQueryRs.Fields.Count - 1
                If myqry.MQueryRs.Fields(j) <> Empty Then
                   mysheet.Cells(i + 3, j + 1).Value = CStr(Trim(myqry.MQueryRs.Fields(j))) '写入Excel表
                Else
                   mysheet.Cells(i + 3, j + 1).Value = "无"
                End If
            Next
        myqry.MQueryRs.MoveNext
        Next
        MyExcel.Visible = True
        'mysheet.SaveAs " E:\SIMS\事务规则服务器\学生考试报表.xls"
        Set myqry = Nothing
   Else
        MsgBox "无符合的信息！请重新输入！"
   End If
ElseIf mydate = "" Then
   Set myqry = New Cls_Connect
   myqry.QryName = "select ExamInfo.ExamDate,ExamInfo.ExamKind,ExamInfo.StudentID,ExamInfo.CourseID from ExamInfo inner join StudentInfo on ExamInfo.StudentID=StudentInfo.StudentID where StudentInfo.ClassID='" & myclassid & "'and CourseId='" & mycourseid & "'and Examkind='" & myexanmkind & "'"
    myqry.openQry
    If myqry.MQueryRs.EOF = False Then
        Set ModelWorkbook = MyExcel.Workbooks
        ModelWorkbook.Open App.Path & "\学生考试报表.xlt", 1
        Set mysheet = MyExcel.Sheets(1)
        mysheet.Activate
        
        For i = 0 To myqry.MQueryRs.RecordCount - 1
            For j = 0 To myqry.MQueryRs.Fields.Count - 1
                If myqry.MQueryRs.Fields(j) <> Empty Then
                   mysheet.Cells(i + 3, j + 1).Value = CStr(Trim(myqry.MQueryRs.Fields(j))) '写入Excel表
                Else
                   mysheet.Cells(i + 3, j + 1).Value = "无"
                End If
            Next
        myqry.MQueryRs.MoveNext
        Next
        MyExcel.Visible = True
        'mysheet.SaveAs " E:\SIMS\事务规则服务器\学生考试报表.xls"
        Set myqry = Nothing
   Else
        MsgBox "无符合的信息！请重新输入！"
   End If
End If
End Function