?? 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)
'打印學(xué)生信息報表
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 & "\學(xué)生信息報表.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\事務(wù)規(guī)則服務(wù)器\學(xué)生信息報表.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)
'打印各個學(xué)期、班級、考試種類、以及分?jǐn)?shù)范圍限制的報表表單
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\事務(wù)規(guī)則服務(wù)器\學(xué)生信息報表.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\事務(wù)規(guī)則服務(wù)器\學(xué)生信息報表.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\事務(wù)規(guī)則服務(wù)器\學(xué)生信息報表.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\事務(wù)規(guī)則服務(wù)器\學(xué)生信息報表.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)
'打印各個學(xué)期、班級、考試種類、以及日期范圍限制的考試報名報表
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 & "\學(xué)生考試報表.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\事務(wù)規(guī)則服務(wù)器\學(xué)生考試報表.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 & "\學(xué)生考試報表.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\事務(wù)規(guī)則服務(wù)器\學(xué)生考試報表.xls"
Set myqry = Nothing
Else
MsgBox "無符合的信息!請重新輸入!"
End If
End If
End Function
?? 快捷鍵說明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -