VB+access评分系统

VB+access评分系统

Option ExplicitDim X As IntegerDim Y As IntegerDim fnt As ByteDim db As ADODB.ConnectionDim rs As ADODB.RecordsetDim rscm As ADODB.RecordsetPublic adoCon As ADODB.ConnectionPublic adoRS As ADODB.RecordsetDim cn As ADODB.ConnectionDim mlink As String, mysql As String Dim sh As StringPrivate Sub Command1_Click()On Error GoTo ErrMsgIf Option1 = True ThenLabel14.Visible = TrueText11.Visible = True mysql = "select * from 成绩表 where 学号='" & Text1 & "'order by 学号" Set cn = New ADODB.Connection cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb;" cn.Open sh = "select MAX(成绩) from 成绩表 where 学号='" & Text1 & "'" '查找最高成绩 Set adoRS = cn.Execute(sh) Text2.Text = adoRS(0) sh = "select MIN(成绩) from 成绩表 where 学号='" & Text1 & "'" '查找最低分 Set adoRS = cn.Execute(sh) Text3.Text = adoRS(0) sh = "select AVG(成绩) from 成绩表 where 学号='" & Text1 & "'" '计算平均分 Set adoRS = cn.Execute(sh) Text4.Text = adoRS(0) sh = "select COUNT(成绩) from 成绩表 where 学号='" & Text1 & "'" & " and 成绩<60" '统计不及格门(次) Set adoRS = cn.Execute(sh) Text5.Text = adoRS(0) sh = "select COUNT(成绩) from 成绩表 where 学号='" & Text1 & "'" & " and 成绩 BETWEEN 90 AND 100" '统计优秀门(次) Set adoRS = cn.Execute(sh) Text6.Text = adoRS(0) sh = "select COUNT(成绩) from 成绩表 where 学号='" & Text1 & "'" & " and 成绩 BETWEEN 80 AND 89" '统计良好门(次) Set adoRS = cn.Execute(sh) Text7.Text = adoRS(0) sh = "select COUNT(成绩) from 成绩表 where 学号='" & Text1 & "'" '统计总门(次)数 Set adoRS = cn.Execute(sh) Text8.Text = adoRS(0) Text9.Text = ((Text8.Text - Text5.Text) / Text8.Text) * 100 & "%" '计算合格率 sh = "select 姓名 from 成绩表 where 学号='" & Text1 & "'" Set adoRS = cn.Execute(sh) Text11.Text = adoRS(0)End IfIf Option2 = True ThenLabel14.Visible = FalseText11.Visible = FalseIf Text11.Visible = False ThenText11.Text = ""End Ifmysql = "select * from 成绩表 where 所在班级='" & DataCombo1 & "'" & " And 课程='" & DataCombo2 & "'order by 学号" Set cn = New ADODB.Connection cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb;" cn.Open sh = "select MAX(成绩) from 成绩表 where 所在班级='" & DataCombo1 & "'" & " And 课程='" & DataCombo2 & "'" Set adoRS = cn.Execute(sh) Text2.Text = adoRS(0) sh = "select MIN(成绩) from 成绩表 where 所在班级='" & DataCombo1 & "'" & " And 课程='" & DataCombo2 & "'" Set adoRS = cn.Execute(sh) Text3.Text = adoRS(0) sh = "select AVG(成绩) from 成绩表 where 所在班级='" & DataCombo1 & "'" & " And 课程='" & DataCombo2 & "'" Set adoRS = cn.Execute(sh) Text4.Text = adoRS(0) sh = "select COUNT(成绩) from 成绩表 where 所在班级='" & DataCombo1 & "'" & " And 课程='" & DataCombo2 & "'" & " and 成绩<60" Set adoRS = cn.Execute(sh) Text5.Text = adoRS(0) sh = "select COUNT(成绩) from 成绩表 where 所在班级='" & DataCombo1 & "'" & " And 课程='" & DataCombo2 & "'" & " and 成绩 BETWEEN 90 AND 100" Set adoRS = cn.Execute(sh) Text6.Text = adoRS(0) sh = "select COUNT(成绩) from 成绩表 where 所在班级='" & DataCombo1 & "'" & " And 课程='" & DataCombo2 & "'" & " and 成绩 BETWEEN 80 AND 89" Set adoRS = cn.Execute(sh) Text7.Text = adoRS(0) sh = "select COUNT(成绩) from 成绩表 where 所在班级='" & DataCombo1 & "'" & " And 课程='" & DataCombo2 & "'" Set adoRS = cn.Execute(sh) Text8.Text = adoRS(0) Text9.Text = ((Text8.Text - Text5.Text) / Text8.Text) * 100 & "%"End IfIf Option3 = True ThenLabel14.Visible = FalseText11.Visible = False mysql = "select * from 成绩表 where 姓名='" & Text10 & "'order by 学号" Set cn = New ADODB.Connection cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb;" cn.Open sh = "select MAX(成绩) from 成绩表 where 姓名='" & Text10 & "'" Set adoRS = cn.Execute(sh) Text2.Text = adoRS(0) sh = "select MIN(成绩) from 成绩表 where 姓名='" & Text10 & "'" Set adoRS = cn.Execute(sh) Text3.Text = adoRS(0) sh = "select AVG(成绩) from 成绩表 where 姓名='" & Text10 & "'" Set adoRS = cn.Execute(sh) Text4.Text = adoRS(0) sh = "select COUNT(成绩) from 成绩表 where 姓名='" & Text10 & "'" & " and 成绩<60" Set adoRS = cn.Execute(sh) Text5.Text = adoRS(0) sh = "select COUNT(成绩) from 成绩表 where 姓名='" & Text10 & "'" & " and 成绩 BETWEEN 90 AND 100" Set adoRS = cn.Execute(sh) Text6.Text = adoRS(0) sh = "select COUNT(成绩) from 成绩表 where 姓名='" & Text10 & "'" & " and 成绩 BETWEEN 80 AND 89" Set adoRS = cn.Execute(sh) Text7.Text = adoRS(0) sh = "select COUNT(成绩) from 成绩表 where 姓名='" & Text10 & "'" Set adoRS = cn.Execute(sh) Text8.Text = adoRS(0) Text9.Text = ((Text8.Text - Text5.Text) / Text8.Text) * 100 & "%"End IfIf rs.State <> adStateClosed Thenrs.CloseEnd Ifrs.Open mysql, db, adOpenStatic, adLockOptimisticSet DataGrid1.DataSource = rs '传递表值rs.MoveLastIf rs.EOF = True ThenMsgBox "无此信息,请确认!"End IfErrMsg: If Err.Number <> 0 Then MsgBox CStr(Err.Number) + Err.Description, vbOKOnly + vbCritical, "错误提示" Exit Sub End IfEnd SubPrivate Sub Command2_Click()Unload MeEnd SubPrivate Sub Command3_Click()On Error GoTo ErrMsgfnt = 15X = 1000Y = 1000Printer.CurrentX = XPrinter.CurrentY = YPrinter.FontSize = fntPrinter.Print "学号:" & Text1Printer.CurrentX = XPrinter.CurrentY = Y + 300Printer.Print Label14 & Text11Printer.CurrentX = XPrinter.CurrentY = Y + 600Printer.Print Label5 & Text2Printer.CurrentX = XPrinter.CurrentY = Y + 900Printer.Print Label6 & Text3Printer.CurrentX = XPrinter.CurrentY = Y + 1200Printer.Print Label7 & Text4Printer.CurrentX = XPrinter.CurrentY = Y + 1500Printer.Print Label8 & Text5Printer.CurrentX = XPrinter.CurrentY = Y + 1800Printer.Print Label9 & Text6Printer.CurrentX = XPrinter.CurrentY = Y + 2100Printer.Print Label10 & Text7Printer.CurrentX = XPrinter.CurrentY = Y + 2400Printer.Print Label11 & Text8Printer.CurrentX = XPrinter.CurrentY = Y + 2700Printer.Print Label12 & Text9Dim i As Long, J As Long, K As Long Dim PrintString As StringY = 4400Printer.CurrentX = 1000Printer.CurrentY = 4000Printer.FontSize = 13Printer.Print "学号/姓名 /课程/成绩/班级" For i = 0 To DataGrid1.Row If K = DataGrid1.VisibleRows Then DataGrid1.Scroll 0, DataGrid1.VisibleRows K = 0 End If For J = 0 To DataGrid1.Columns.Count - 1 PrintString = PrintString & _ DataGrid1.Columns(J).CellText(DataGrid1.RowBookmark(K)) & "/" NextPrinter.CurrentX = 1000Printer.CurrentY = YPrinter.FontSize = 10 Printer.Print PrintString PrintString = "" K = K + 1 Y = Y + 300 DoEvents If i = DataGrid1.Row Then '无此条件则打印机与计算机不断开，不能进行新的打印任务 Printer.EndDoc End If NextErrMsg: If Err.Number <> 0 Then MsgBox CStr(Err.Number) + Err.Description, vbOKOnly + vbCritical, "错误提示" Exit Sub End IfEnd SubPrivate Sub Command4_Click()DataReport2.ShowEnd SubPrivate Sub Form_Load()Set db = New ADODB.ConnectionSet rs = New ADODB.Recordsetdb.CursorLocation = adUseClientmlink = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\db1.mdb;"db.Open mlinkmysql = "select * from 成绩表 order by 学号"rs.Open mysql, db, adOpenStatic, adLockOptimisticSet DataGrid1.DataSource = rsEnd Sub