📄 frm_sjss2.frm
字号:
VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form frm_sjss2
Caption = "试卷搜索"
ClientHeight = 5715
ClientLeft = 3195
ClientTop = 3255
ClientWidth = 9030
Icon = "frm_sjss2.frx":0000
MDIChild = -1 'True
ScaleHeight = 5715
ScaleWidth = 9030
WindowState = 2 'Maximized
Begin VB.Data Data3
Caption = "Data2"
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 0 '缺省游标
DefaultType = 2 '使用 ODBC
Exclusive = 0 'False
Height = 375
Left = 3840
Options = 0
ReadOnly = 0 'False
RecordsetType = 1 'Dynaset
RecordSource = ""
Top = 6960
Width = 1140
End
Begin VB.CommandButton Command5
Caption = "修改所选试卷(&O)"
Default = -1 'True
Height = 495
Left = 5280
TabIndex = 2
Top = 4920
Width = 1815
End
Begin VB.CommandButton Command3
Cancel = -1 'True
Caption = "关闭搜索窗体(&C)"
Height = 495
Left = 1680
TabIndex = 1
Top = 4920
Width = 1575
End
Begin MSDBGrid.DBGrid DBGrid1
Bindings = "frm_sjss2.frx":030A
Height = 4695
Left = 0
OleObjectBlob = "frm_sjss2.frx":031E
TabIndex = 0
Top = 0
Width = 9015
End
End
Attribute VB_Name = "frm_sjss2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public sql As String
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Command5_Click()
Call go_mod
End Sub
Private Sub DBGrid1_DblClick()
Call go_mod
End Sub
Private Sub Form_Load()
Call Frm_main.menu_show(False) '菜单控制
Data3.DatabaseName = DName
Data3.RecordSource = sql ' "shijuan"
'If mod_type = "sjsc" Then '试卷删除
' Me.Caption = "试卷删除"
' Command5.Caption = "删除所选试卷(&D)"
If mod_type = "sjsc" Then '试卷删除
Me.Caption = "试卷删除"
Command5.Caption = "删除所选试卷(&D)"
ElseIf mod_type = "cjhd" Then '试卷核对
Me.Caption = "录入成绩核对"
Command5.Caption = "核对所选试卷(&S)"
ElseIf mod_type = "fxbg" Then '分析报告生成
Me.Caption = "试卷统计分析"
Command5.Caption = "分析所选试卷(&S)"
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call Frm_main.menu_show(True) '菜单控制
End Sub
Private Sub go_mod()
Dim i, j, total_ti As Integer
Dim col_width As Double, fen As Double, total_fen As Double
Dim col As String
If mod_type = "zlxg" Then '资料修改
frm_sjss3.SJID = DBGrid1.Columns(0)
frm_sjss3.str_Institute = DBGrid1.Columns(1)
frm_sjss3.str_Teacher = DBGrid1.Columns(2)
frm_sjss3.str_Course = DBGrid1.Columns(3)
frm_sjss3.str_Classes = DBGrid1.Columns(4)
frm_sjss3.str_Year = DBGrid1.Columns(5)
frm_sjss3.str_term = DBGrid1.Columns(6)
Frm_main.tform = "sjss3"
frm_sjss3.Show
ElseIf mod_type = "cjxg" Then '成绩修改
frm_sjss4.SJID = DBGrid1.Columns(0)
Frm_main.tform = "sjss4"
frm_sjss4.Show
ElseIf mod_type = "sjsc" Then '试卷删除
If MsgBox("确定要删除该试卷吗？", vbOKCancel, "删除后无法恢复！") = 1 Then
DB.Execute ("delete from shijuan where SJID=" + VBA.Str(DBGrid1.Columns(0)))
Data3.Refresh
End If
ElseIf mod_type = "cjhd" Then '试卷核对 'exl.Workbooks.Open()'exl.Worksheets(0).Select'exl.Selection = 5
'exl.Cells(1, 1).Select
Set RS = DB.OpenRecordset("select * from shijuan where SJID=" + VBA.Str(DBGrid1.Columns(0)))
If RS.RecordCount > 0 Then
Set RS_t = DB.OpenRecordset("select * from stu_cj where SJID=" + VBA.Str(DBGrid1.Columns(0)))
If RS_t.RecordCount > 0 Then
Set exl = New Excel.Application
exl.Workbooks.Add
exl.Visible = True
total_ti = RS.Fields("Total_ti").Value
col_width = 87 / (total_ti + 1)
col = Get_Exl_Col(1)
exl.Columns(col).ColumnWidth = 13
'exl.Columns(col).HorizontalAlignment = VtHorizontalAlignmentCenter
For i = 1 To total_ti
exl.Cells(3, i + 1).Value = "第" + VBA.Trim(VBA.Str(i)) + "题"
col = Get_Exl_Col(i + 1)
exl.Columns(col).ColumnWidth = col_width
'exl.Columns(col).HorizontalAlignment = VtHorizontalAlignmentCenter
Next i
exl.Cells(3, i + 1).Value = "总分"
col = Get_Exl_Col(i + 1)
exl.Columns(col).ColumnWidth = col_width
'exl.Columns(col).HorizontalAlignment = VtHorizontalAlignmentCenter
'For i = 1 To RS_t.RecordCount
i = 1
Do While Not RS_t.EOF
total_fen = 0
exl.Cells(3 + i, 1).Value = RS_t.Fields("SID").Value
For j = 1 To total_ti
fen = RS_t.Fields("T" + VBA.Trim(VBA.Str(j))).Value
exl.Cells(3 + i, 1 + j).Value = fen
total_fen = total_fen + fen
Next j
exl.Cells(3 + i, 1 + j).Value = total_fen
RS_t.MoveNext
i = i + 1
Loop
' Next i
exl.Cells(1, 1).Value = RS.Fields("Institute").Value + RS.Fields("Year").Value + "学年第" + RS.Fields("Term").Value + "学期考试（考查）成绩登记表"
exl.Cells(2, 1).Value = "班级：" + RS.Fields("Classes").Value + " 课程名称：" + RS.Fields("Course").Value + " 任课教师：" + RS.Fields("Teacher").Value
exl.Cells(3, 1).Value = "学号"
Call Unite_Exl_Col(1, total_ti + 2, 1) '合并第一行
Call Unite_Exl_Col(1, total_ti + 2, 2) '合并第二行
Else
MsgBox "该试卷的没有成绩录入！", vbOK, "信息提示"
End If
RS_t.Close
Else
MsgBox "没有该试卷的信息！", vbOK, "信息提示"
End If
RS.Close
'@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
ElseIf mod_type = "fxbg" Then '分析报告生成
Set RS = DB.OpenRecordset("select * from shijuan where SJID=" + VBA.Str(DBGrid1.Columns(0)))
If RS.RecordCount > 0 Then
Set RS_t = DB.OpenRecordset("select * from stu_cj where SJID=" + VBA.Str(DBGrid1.Columns(0)))
If RS_t.RecordCount > 0 Then
'Dim i, j, total_ti As Integer
'Dim col_width As Double, fen As Double, total_fen As Double
'Dim col As String
Dim f_Max As Double, f_Min As Double, f_Avg As Double
Dim Q_nd As Double, Q_nd_m(10) As Double '难度
Dim D_qfd As Double '区分度
Dim fens(10, 2) As Double
Dim fd(6) '分段数组，即各分数段的人数，如fd(1)为90分以上的人
Dim Num As Integer
Dim p As Double
Dim tt(999) As Double '每个学生的分数
Dim str_num As String
str_num = "一二三四五六七八九十"
f_Max = 0
f_Min = 99999
' For i = 1 To 10
' fens(i, 1) = -99999
' Next i
For i = 1 To 6
fd(i) = 0
Next i
total_ti = RS.Fields("Total_ti").Value '试卷总题数
'取每个人的分数，计算最高分，最低分，等。。
Do While Not RS_t.EOF
Num = Num + 1
For j = 1 To total_ti
fen = RS_t.Fields("T" + VBA.Trim(VBA.CStr(j))).Value
'If fen > fens(j, 2) Then fens(j, 2) = fen
fens(j, 2) = RS.Fields("T" + VBA.Trim(VBA.CStr(j))).Value
fens(j, 1) = fens(j, 1) + fen
tt(Num) = tt(Num) + fen
Next j
' fens(j, 2) = fens(j, 1) / Num
If tt(Num) > f_Max Then f_Max = tt(Num)
If tt(Num) < f_Min Then f_Min = tt(Num)
total_fen = total_fen + tt(Num)
If tt(Num) >= 90 Then
fd(1) = fd(1) + 1
ElseIf tt(Num) >= 80 Then
fd(2) = fd(2) + 1
ElseIf tt(Num) >= 70 Then
fd(3) = fd(3) + 1
ElseIf tt(Num) >= 60 Then
fd(4) = fd(4) + 1
ElseIf tt(Num) >= 40 Then
fd(5) = fd(5) + 1
Else
fd(6) = fd(6) + 1
End If
RS_t.MoveNext
Loop
f_Avg = total_fen / Num '平均分
'计算整个试卷的难度
For i = 1 To total_ti
Q_nd_m(i) = 1 - fens(i, 1) / Num / fens(i, 2) '每道题的难度
Q_nd = Q_nd + CDbl(RS.Fields("t" + VBA.Trim(VBA.CStr(i))).Value) * Q_nd_m(i)
Next i
Q_nd = Q_nd / 100
'计算整个试卷的区分度
Dim sh As Double, sl As Double, n As Integer
p = Num * 27 / 100
n = CInt(Get_Point(p, -1)) + 1
'排序
For i = 1 To Num - 1
For j = 2 To Num
If tt(i) > tt(j) Then
p = tt(i)
tt(i) = tt(j)
tt(j) = p
End If
Next j
Next i
For i = 1 To n
sh = sh + tt(Num + 1 - i) '高分组
sl = sl + tt(i) '低分组
Next i
D_qfd = (sh - sl) / (n * (f_Max - f_Min))
Dim exwbook As Excel.Workbook
Set exl = CreateObject("excel.application")
Set exwbook = exl.Workbooks.Open(App.Path + "\result\Paper1.xls")
exl.Visible = True
'exl.Cells(3, 1).Value = "班 级:"
exl.Cells(3, 2).Value = RS.Fields("Classes").Value
'exl.Cells(3, 5).Value = "统计日期："
exl.Cells(3, 6).Value = VBA.Date
'exl.Cells(4, 1).Value = "课程名称"
exl.Cells(4, 2).Value = RS.Fields("Course").Value
'exl.Cells(4, 4).Value = "任课教师"
exl.Cells(4, 5).Value = RS.Fields("Teacher").Value
'exl.Cells(4, 6).Value = "考试人数"
exl.Cells(4, 7).Value = RS.Fields("Stu_Num").Value
'exl.Cells(5, 1).Value = "分数统计"
' exl.Cells(5, 2).Value = "最高分"
exl.Cells(5, 3).Value = f_Max
' exl.Cells(5, 4).Value = "最低分"
exl.Cells(5, 5).Value = f_Min
' exl.Cells(5, 6).Value = "平均分"
exl.Cells(5, 7).Value = f_Avg
For i = 1 To total_ti
exl.Cells(6 + i, 3).Value = Get_Point(Q_nd_m(i), 2)
Next i
For i = total_ti + 1 To 10
exl.Cells(6 + i, 3).Value = ""
Next i
exl.Cells(17, 3).Value = Get_Point(Q_nd, 3)
exl.Cells(18, 3).Value = Get_Point(D_qfd, 3)
For i = 1 To 6
exl.Cells(20, i + 1).Value = fd(i)
p = fd(i) / Num * 100
exl.Cells(21, i + 1).Value = Get_Point(p, 2) + "%"
Next i
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -