📄 frmcj2.frm
字号:
Width = 735
End
Begin VB.Label Label1
Caption = "语文："
Height = 255
Index = 4
Left = 240
TabIndex = 19
Top = 1080
Visible = 0 'False
Width = 735
End
Begin VB.Label Label1
Caption = "语文："
Height = 255
Index = 3
Left = 3480
TabIndex = 18
Top = 720
Visible = 0 'False
Width = 735
End
Begin VB.Label Label1
Caption = "语文："
Height = 255
Index = 2
Left = 240
TabIndex = 17
Top = 720
Visible = 0 'False
Width = 735
End
Begin VB.Label Label1
Caption = "语文："
Height = 255
Index = 1
Left = 3480
TabIndex = 16
Top = 360
Visible = 0 'False
Width = 735
End
End
Begin VB.Label Label4
Caption = "学期："
Height = 255
Left = 840
TabIndex = 42
Top = 525
Width = 615
End
Begin VB.Label Label3
Caption = "班级："
Height = 255
Left = 840
TabIndex = 41
Top = 885
Width = 615
End
Begin VB.Label Label2
Caption = "学号："
Height = 255
Left = 840
TabIndex = 40
Top = 1230
Width = 615
End
Begin VB.Label Label5
Caption = "类型："
Height = 255
Left = 3960
TabIndex = 34
Top = 885
Width = 615
End
Begin VB.Label Label7
Caption = "姓名："
Height = 255
Left = 3960
TabIndex = 33
Top = 1245
Width = 615
End
End
Begin VB.Label Label6
Caption = "成绩添加"
BeginProperty Font
Name = "楷体_GB2312"
Size = 21.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 495
Left = 2400
TabIndex = 29
Top = 120
Width = 2055
End
End
Attribute VB_Name = "frmcj2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim gg As Integer
Dim kechengcount As Integer
Public aaa As Boolean
Private Sub Combo1_Click()
If Combo2.Text = "" Or Combo1.Text = "" Then
Exit Sub
End If
fillkencheng
End Sub
Private Sub Combo2_Click()
Dim mrc As ADODB.Recordset
txtsql = "select DISTINCT 学号 from xj where 班级='" & Trim(Combo2.Text) & "' order by 学号"
Set mrc = ExecuteSQL(txtsql)
If mrc.EOF = True Then
Combo4.Clear
Text2.Text = ""
Else
mrc.MoveFirst
Combo4.Clear
Do While Not mrc.EOF
Combo4.AddItem mrc.Fields(0)
mrc.MoveNext
Loop
Combo4.ListIndex = 0
Set mrc = Nothing
End If
If Combo2.Text = "" Or Combo1.Text = "" Then
Exit Sub
End If
fillkencheng
End Sub
Private Sub Combo4_Change()
If Trim(Combo4.Text) = "" Then
List1.Clear
List1.Visible = False
Exit Sub
End If
If aaa = True Then
List1.Clear
List1.Visible = False
Dim mrc As ADODB.Recordset
txtsql = "select DISTINCT 姓名 from xj where 学号 ='" & Trim(Combo4.Text) & "'"
Set mrc = ExecuteSQL(txtsql)
If mrc.EOF = True Then
sss = MsgBox("没有此学号！", vbExclamation + vbOKOnly, "警告")
Text2.Text = ""
Exit Sub
End If
Text2.Text = mrc.Fields(0)
Set mrc = Nothing
Exit Sub
End If
Dim rst As ADODB.Recordset
Dim str As String
str = "select 学号 from xj where 学号 like'" & Trim(Combo4.Text) & "%' and 班级='" & Trim(Combo2.Text) & "' order by 学号"
Set rst = ExecuteSQL(str)
If rst.EOF = True Then
List1.Clear
List1.Visible = False
Set rst = Nothing
Exit Sub
End If
List1.Clear
Do Until rst.EOF
List1.AddItem rst.Fields(0)
rst.MoveNext
Loop
Set rst = Nothing
List1.Visible = True
End Sub
Private Sub Combo4_Click()
Dim mrc As ADODB.Recordset
txtsql = "select DISTINCT 姓名 from xj where 学号 ='" & Trim(Combo4.Text) & "'"
Set mrc = ExecuteSQL(txtsql)
Text2.Text = mrc.Fields(0)
Set mrc = Nothing
End Sub
Private Sub Combo4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Dim mrc As ADODB.Recordset
txtsql = "select DISTINCT 姓名 from xj where 学号 ='" & Trim(Combo4.Text) & "'"
Set mrc = ExecuteSQL(txtsql)
If mrc.EOF = True Then
sss = MsgBox("没有此学号！", vbExclamation + vbOKOnly, "警告")
Text2.Text = ""
Exit Sub
End If
Text2.Text = mrc.Fields(0)
Set mrc = Nothing
Else
aaa = False
End If
End Sub
Private Sub Command1_Click()
For i = 0 To 13
If Trim(Text1(i).Text) = "" Then
Text1(i).Text = "0"
End If
Next i
If Combo4.Text = "" Then
sss = MsgBox("学号不能为空！", vbExclamation + vbOKOnly, "警告")
Combo4.SetFocus
Exit Sub
End If
Dim mrc As ADODB.Recordset
txtsql = "select 学号 from cj where 学号='" & Trim(Combo4.Text) & "' and 学期='" & Trim(Combo1.Text) & "' and 类型='" & Trim(Combo3.Text) & "'"
Set mrc = ExecuteSQL(txtsql)
If mrc.EOF = False Then
sss = MsgBox("已存在该学号本学期的成绩记录！", vbExclamation + vbOKOnly, "警告")
Combo4.SetFocus
Combo4.SelStart = 0
Combo4.SelLength = Len(Combo4.Text)
Exit Sub
End If
txtsql = "select * from cj"
Set mrc = ExecuteSQL(txtsql)
For i = 0 To (kechengcount - 1)
mrc.AddNew
mrc.Fields(0) = Trim(Combo4.Text)
mrc.Fields(1) = Trim(Combo1.Text)
mrc.Fields(2) = Trim(Combo3.Text)
mrc.Fields(3) = Trim(Label1(i).Caption)
mrc.Fields(4) = Val(Trim(Text1(i).Text))
mrc.Update
Next i
For i = 0 To 13
Text1(i).Text = "0"
Next i
Combo4.Text = ""
Text2.Text = ""
Combo4.SetFocus
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Activate()
List1.Visible = False
Dim mrc As ADODB.Recordset
txtsql = "select DISTINCT 班级 from class order by 班级"
Set mrc = ExecuteSQL(txtsql)
mrc.MoveFirst
Combo2.Clear
Do While Not mrc.EOF
Combo2.AddItem mrc.Fields(0)
mrc.MoveNext
Loop
Combo2.ListIndex = 0
Combo1.AddItem Val(Format(Date, "yyyy")) - 1 & "---" & Val(Format(Date, "yyyy")) & "年级第一学期"
Combo1.AddItem Val(Format(Date, "yyyy")) - 1 & "---" & Val(Format(Date, "yyyy")) & "年级第二学期"
Combo1.AddItem Format(Date, "yyyy") & "---" & Val(Format(Date, "yyyy")) + 1 & "年级第一学期"
Combo1.AddItem Format(Date, "yyyy") & "---" & Val(Format(Date, "yyyy")) + 1 & "年级第二学期"
Combo1.AddItem Val(Format(Date, "yyyy")) + 1 & "---" & Val(Format(Date, "yyyy")) + 2 & "年级第一学期"
Combo1.AddItem Val(Format(Date, "yyyy")) + 1 & "---" & Val(Format(Date, "yyyy")) + 2 & "年级第二学期"
If Val(Format(Date, "mm")) > 8 Then
Combo1.ListIndex = 2
Else
Combo1.ListIndex = 1
End If
txtsql = "select * from kaoshileixing"
Set mrc = ExecuteSQL(txtsql)
Combo3.Clear
mrc.MoveFirst
Do While Not mrc.EOF
Combo3.AddItem mrc.Fields(0)
mrc.MoveNext
Loop
Combo3.ListIndex = 0
Set mrc = Nothing
fillkencheng
End Sub
Private Sub fillkencheng()
Dim mrc As ADODB.Recordset
Dim mrc1 As ADODB.Recordset
For i = 0 To 13
Label1(i).Visible = False
Text1(i).Visible = False
Next i
txtsql = "select 年级,专业,年制 from class where 班级='" & Trim(Combo2.Text) & "'"
Set mrc1 = ExecuteSQL(txtsql)
txtsql = "select 课程名称 from classkecheng where 学期='" & Trim(Combo1.Text) & "'and 年级='" & Trim(mrc1.Fields(0)) & "' and 专业='" & Trim(mrc1.Fields(1)) & "' and 年制='" & Trim(mrc1.Fields(2)) & "'"
Set mrc1 = Nothing
Set mrc = ExecuteSQL(txtsql)
Dim ssss As String
If mrc.EOF = True Then
sss = MsgBox("请先设置班级课程！", vbExclamation + vbOKOnly, "警告")
Command1.Enabled = False
Command2.Enabled = False
Label1(0).Visible = False
Exit Sub
End If
Command1.Enabled = True
Command2.Enabled = True
mrc.MoveFirst
kechengcount = mrc.RecordCount
For i = 0 To (mrc.RecordCount - 1)
Label1(i).Visible = True
Text1(i).Visible = True
Label1(i).Caption = mrc.Fields(0)
Text1(i).Text = 0
mrc.MoveNext
Next i
Text1(0).SetFocus
Frame3.Height = 410 + Int(i / 2 + 0.5) * 360
Frame1.Height = 2000 + Frame3.Height
Me.Height = 1800 + Frame1.Height
Set mrc = Nothing
End Sub
Private Sub Form_Resize()
Command1.Top = Me.Height - 800
Command2.Top = Me.Height - 800
End Sub
Private Sub List1_Click()
aaa = True
Combo4.Text = List1.List(List1.ListIndex)
End Sub
Private Sub Text1_GotFocus(Index As Integer)
List1.Visible = False
Text1(Index).SelStart = 0
Text1(Index).SelLength = Len(Text1(6).Text)
End Sub
Private Sub Text1_KeyPress(Index As Integer, KeyAscii As Integer)
Dim shao As Integer
Dim zs As String
If KeyAscii <> 8 And KeyAscii <> 13 Then
shao = InStr(Trim(Text1(Index).Text), ".")
If shao <> 0 Then
zs = Right(Trim(Text1(Index).Text), Len(Trim(Text1(Index).Text)) - shao)
If Len(zs) > 1 Then KeyAscii = 0
End If
End If
If Val(Text1(Index).Text & Chr(KeyAscii)) > 100 Then
KeyAscii = 0
Exit Sub
End If
If KeyAscii = 13 Or KeyAscii = 46 Or KeyAscii > 47 And KeyAscii < 58 Or KeyAscii = 8 Then
Else
KeyAscii = 0
Exit Sub
End If
If KeyAscii = 13 Then
SendKeys "{TAB}"
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -