📄 frmccount.frm
字号:
Begin VB.Label Label19
AutoSize = -1 'True
Caption = "均分"
ForeColor = &H00C00000&
Height = 180
Left = 5200
TabIndex = 34
Top = 960
Width = 360
End
Begin VB.Label Label18
AutoSize = -1 'True
Caption = "总分"
ForeColor = &H00C00000&
Height = 180
Left = 4560
TabIndex = 33
Top = 960
Width = 360
End
Begin VB.Label Label17
AutoSize = -1 'True
Caption = "优秀率"
ForeColor = &H00C00000&
Height = 180
Left = 3720
TabIndex = 32
Top = 960
Width = 540
End
Begin VB.Label Label16
AutoSize = -1 'True
Caption = "优秀数"
ForeColor = &H00C00000&
Height = 180
Left = 3050
TabIndex = 31
Top = 960
Width = 540
End
Begin VB.Label Label15
AutoSize = -1 'True
Caption = "及格率"
ForeColor = &H00C00000&
Height = 180
Left = 2300
TabIndex = 30
Top = 960
Width = 540
End
Begin VB.Label Label14
AutoSize = -1 'True
Caption = "及格数"
ForeColor = &H00C00000&
Height = 180
Left = 1600
TabIndex = 29
Top = 960
Width = 540
End
Begin VB.Label Label13
AutoSize = -1 'True
Caption = "卷面总分"
ForeColor = &H00800080&
Height = 180
Left = 765
TabIndex = 28
Top = 960
Width = 720
End
Begin VB.Label Label12
AutoSize = -1 'True
Caption = "学科"
ForeColor = &H00C00000&
Height = 180
Left = 260
TabIndex = 27
Top = 960
Width = 360
End
Begin VB.Label labXk
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "生物"
ForeColor = &H00008000&
Height = 180
Index = 8
Left = 240
TabIndex = 26
Top = 3720
Width = 360
End
Begin VB.Label labXk
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "地理"
ForeColor = &H00008000&
Height = 180
Index = 7
Left = 240
TabIndex = 25
Top = 3435
Width = 360
End
Begin VB.Label labXk
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "历史"
ForeColor = &H00008000&
Height = 180
Index = 6
Left = 240
TabIndex = 24
Top = 3135
Width = 360
End
Begin VB.Label labXk
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "政治"
ForeColor = &H00008000&
Height = 180
Index = 5
Left = 240
TabIndex = 23
Top = 2835
Width = 360
End
Begin VB.Label labXk
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "化学"
ForeColor = &H00008000&
Height = 180
Index = 4
Left = 240
TabIndex = 22
Top = 2535
Width = 360
End
Begin VB.Label labXk
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "物理"
ForeColor = &H00008000&
Height = 180
Index = 3
Left = 240
TabIndex = 21
Top = 2235
Width = 360
End
Begin VB.Label labXk
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "英语"
ForeColor = &H00008000&
Height = 180
Index = 2
Left = 240
TabIndex = 20
Top = 1935
Width = 360
End
Begin VB.Label labXk
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "数学"
ForeColor = &H00008000&
Height = 180
Index = 1
Left = 240
TabIndex = 19
Top = 1635
Width = 360
End
Begin VB.Label labXk
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "语文"
ForeColor = &H00008000&
Height = 180
Index = 0
Left = 240
TabIndex = 18
Top = 1320
Width = 360
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "在籍数："
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000080&
Height = 240
Left = 2520
TabIndex = 17
Top = 240
Width = 1020
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "班级："
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000080&
Height = 240
Index = 0
Left = 240
TabIndex = 16
Top = 360
Width = 765
End
Begin VB.Label Label4
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "计 外："
BeginProperty Font
Name = "楷体_GB2312"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00000080&
Height = 240
Left = 2520
TabIndex = 109
Top = 600
Width = 1035
End
End
Attribute VB_Name = "FrmCCount"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RsCount As ADODB.Recordset
Dim CmdExec As ADODB.Command
Dim i As Integer
Dim Jwsf As String
Dim AddFlg As Boolean
Private Sub Combo1_LostFocus()
On Error GoTo err
Dim ctl As Control
For Each ctl In Controls
If TypeOf ctl Is TextBox Then
ctl.Text = "0"
End If
Next ctl
If Combo1.ListIndex = -1 Then
Exit Sub
Else
RsCount.Open "select distinct a.考试性质 as ksxz from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 Where b.班级 Like " & Combo1.Text, Con, adOpenStatic, , adCmdText
Combo2.Clear
Text1.Text = ""
Combo2.Text = "请选择性质"
Combo2.Enabled = False
If RsCount.EOF = False And RsCount.BOF = False Then
RsCount.MoveFirst
Do While RsCount.EOF = False
Combo2.AddItem RsCount!Ksxz
RsCount.MoveNext
Combo2.Enabled = True
Loop
End If
RsCount.Close
End If
Exit Sub
err:
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub
Private Sub Command1_Click()
On Error GoTo wrong
If Combo1.ListIndex = -1 Or Combo2.ListIndex = -1 Or Text1.Text = "" Then
MsgBox "统计需要项目未完整提供！"
Exit Sub
End If
If Combo3.ListIndex = -1 And (Combo3.Text <> "否" And Combo3.Text <> "是") Then
MsgBox "计外生情况描述不完整！"
Exit Sub
Else
If Combo3.Text = "否" Then
Else
End If
End If
txtZf(9).Text = ""
txtZf(9).Text = txtZf(0).Text * 1 + txtZf(1).Text * 1 + txtZf(2).Text * 1 + txtZf(3).Text * 1 + txtZf(4).Text * 1 + txtZf(5).Text * 1 + txtZf(6).Text * 1 + txtZf(7).Text * 1 + txtZf(8).Text * 1
If Combo3.Text = "否" Then
For i = 0 To 9
If txtZf(i).Text <> 0 Then
RsCount.Open "select count(*) as ywj from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 where b.计外 = '" & Combo3.Text & "' and b.班级 like " & Combo1.Text & " and a.考试性质 = '" & Combo2.Text & "' and a." & labXk(i).Caption & " >= " & txtZf(i).Text * 0.6, Con, adOpenStatic, , adCmdText
txtZf(10 + i).Text = RsCount!ywj
txtZf(20 + i).Text = RsCount!ywj / Text1.Text * 100
RsCount.Close
RsCount.Open "select count(*) as ywy from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 where b.计外 = '" & Combo3.Text & "' and b.班级 like " & Combo1.Text & " and a.考试性质 = '" & Combo2.Text & "' and a." & labXk(i).Caption & ">=" & txtZf(i).Text * 0.85, Con, adOpenStatic, , adCmdText
txtZf(30 + i).Text = RsCount!ywy
txtZf(40 + i).Text = RsCount!ywy / Text1.Text * 100
RsCount.Close
RsCount.Open "select sum(" & labXk(i).Caption & ") as ywz , count(*) as rs from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 where b.计外 = '" & Combo3.Text & "' and b.班级 like " & Combo1.Text & " and a.考试性质 = '" & Combo2.Text & "'", Con, adOpenStatic, , adCmdText
txtZf(50 + i).Text = RsCount!ywz
txtZf(60 + i).Text = RsCount!ywz / Text1.Text
txtZf(70 + i).Text = txtZf(20 + i).Text * 0.4 + txtZf(40 + i).Text * 0.2 + txtZf(60 + i).Text * 0.4
txtZf(80 + i).Text = RsCount!rs
RsCount.Close
End If
Next i
End If
If Combo3.Text = "是" Then
For i = 0 To 9
If txtZf(i).Text <> 0 Then
RsCount.Open "select count(*) as ywj from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 where b.班级 like " & Combo1.Text & " and a.考试性质 = '" & Combo2.Text & "' and a." & labXk(i).Caption & " >= " & txtZf(i).Text * 0.6, Con, adOpenStatic, , adCmdText
txtZf(10 + i).Text = RsCount!ywj
txtZf(20 + i).Text = RsCount!ywj / Text1.Text * 100
RsCount.Close
RsCount.Open "select count(*) as ywy from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 where b.班级 like " & Combo1.Text & " and a.考试性质 = '" & Combo2.Text & "' and a." & labXk(i).Caption & ">=" & txtZf(i).Text * 0.85, Con, adOpenStatic, , adCmdText
txtZf(30 + i).Text = RsCount!ywy
txtZf(40 + i).Text = RsCount!ywy / Text1.Text * 100
RsCount.Close
RsCount.Open "select sum(" & labXk(i).Caption & ") as ywz , count(*) as rs from 成绩表 AS a INNER JOIN 学籍表 AS b ON a.考试号 = b.考试号 where b.班级 like " & Combo1.Text & " and a.考试性质 = '" & Combo2.Text & "'", Con, adOpenStatic, , adCmdText
txtZf(50 + i).Text = RsCount!ywz
txtZf(60 + i).Text = RsCount!ywz / Text1.Text
txtZf(70 + i).Text = txtZf(20 + i).Text * 0.4 + txtZf(40 + i).Text * 0.2 + txtZf(60 + i).Text * 0.4
txtZf(80 + i).Text = RsCount!rs
RsCount.Close
End If
Next i
End If
Command3.Enabled = True
Exit Sub
wrong:
If err.Number = 3705 Then
RsCount.Close
MsgBox "内部错误，请重新按一下“统计”按钮！"
Exit Sub
End If
MsgBox err.Number & err.Description & "，请检查您的初始值"
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
Dim ctl As Control
For Each ctl In Controls
If TypeOf ctl Is TextBox Then
ctl.Text = "0"
End If
Next ctl
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Command3_Click()
On Error GoTo err
Set CmdExec = New ADODB.Command
CmdExec.ActiveConnection = Con
Dim SqlString As String
For i = 0 To 9
If txtZf(i).Text <> 0 Then
SqlString = "insert into 考核表(班级,在籍数,计外,考试性质,学科,卷面总分,及格数,及格率,优秀数,优秀率,总分,均分,[442],参考数) values " & "(" & Combo1.Text & "," & Text1.Text & ",'" & Combo3.Text & "','" & Combo2.Text & "','" & labXk(i).Caption & "'," & txtZf(i).Text & "," & txtZf(i + 10).Text & "," & txtZf(i + 20).Text & "," & txtZf(i + 30).Text & "," & txtZf(i + 40).Text & "," & txtZf(i + 50).Text & "," & txtZf(i + 60).Text & ",'" & txtZf(i + 70).Text & "'," & txtZf(i + 80).Text & ")"
CmdExec.CommandText = SqlString
CmdExec.Execute
End If
Command3.Enabled = False
Next i
MsgBox "添加存储成功！"
Exit Sub
err:
MsgBox "存储错误！"
Call ExecErr(Date, Me.Caption, err.Number, err.Source, err.Description)
End Sub
Private Sub Form_Load()
Left = (Screen.Width - Width) \ 2
Top = (Screen.Height - Height) \ 2 '使窗体居中
Set RsCount = New ADODB.Recordset
End Sub
Private Sub txtZf_KeyPress(Index As Integer, KeyAscii As Integer)
If Not IsNumeric(Chr(KeyAscii)) Then
KeyAscii = 0
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -