📄 frmsushe2.frm
字号:
Top = 3720
Width = 615
End
Begin VB.Label Label16
BackColor = &H00FFFFFF&
Caption = "性别："
Height = 255
Left = 3720
TabIndex = 22
Top = 3360
Width = 615
End
Begin VB.Label Label15
BackColor = &H00FFFFFF&
Caption = "姓名："
Height = 255
Left = 2040
TabIndex = 20
Top = 3360
Width = 615
End
Begin VB.Label Label14
BackColor = &H00FFFFFF&
Caption = "学号："
Height = 255
Left = 120
TabIndex = 18
Top = 3360
Width = 615
End
Begin VB.Label Label13
BackColor = &H00FFFFFF&
Caption = "床位3："
Height = 255
Left = 240
TabIndex = 17
Top = 3120
Width = 735
End
Begin VB.Line Line1
Index = 1
X1 = 120
X2 = 5400
Y1 = 3000
Y2 = 3000
End
Begin VB.Label Label12
BackColor = &H00FFFFFF&
Caption = "班别："
Height = 255
Left = 2640
TabIndex = 16
Top = 2280
Width = 615
End
Begin VB.Label Label11
BackColor = &H00FFFFFF&
Caption = "专业："
Height = 255
Left = 120
TabIndex = 15
Top = 2280
Width = 615
End
Begin VB.Label Label10
BackColor = &H00FFFFFF&
Caption = "性别："
Height = 255
Left = 3720
TabIndex = 14
Top = 1920
Width = 615
End
Begin VB.Label Label9
BackColor = &H00FFFFFF&
Caption = "姓名："
Height = 255
Left = 2040
TabIndex = 12
Top = 1920
Width = 615
End
Begin VB.Label Label8
BackColor = &H00FFFFFF&
Caption = "学号："
Height = 255
Left = 120
TabIndex = 10
Top = 1920
Width = 615
End
Begin VB.Label Label7
BackColor = &H00FFFFFF&
Caption = "床位2："
Height = 255
Left = 240
TabIndex = 9
Top = 1680
Width = 735
End
Begin VB.Line Line1
Index = 0
X1 = 120
X2 = 5400
Y1 = 1560
Y2 = 1560
End
Begin VB.Label Label6
BackColor = &H00FFFFFF&
Caption = "班别："
Height = 255
Left = 2640
TabIndex = 8
Top = 840
Width = 735
End
Begin VB.Label Label5
BackColor = &H00FFFFFF&
Caption = "专业："
Height = 255
Left = 120
TabIndex = 7
Top = 840
Width = 735
End
Begin VB.Label Label4
BackColor = &H00FFFFFF&
Caption = "性别："
Height = 255
Left = 3720
TabIndex = 6
Top = 480
Width = 615
End
Begin VB.Label Label3
BackColor = &H00FFFFFF&
Caption = "姓名："
Height = 255
Left = 2040
TabIndex = 4
Top = 480
Width = 615
End
Begin VB.Label Label2
BackColor = &H00FFFFFF&
Caption = "学号："
Height = 255
Index = 0
Left = 120
TabIndex = 2
Top = 480
Width = 615
End
Begin VB.Label Label1
BackColor = &H00FFFFFF&
Caption = "床位1："
Height = 255
Index = 0
Left = 240
TabIndex = 1
Top = 240
Width = 975
End
End
Begin ShockwaveFlashObjectsCtl.ShockwaveFlash ShockwaveFlash1
Height = 1935
Left = 2520
TabIndex = 71
Top = -240
Width = 4815
_cx = 8493
_cy = 3413
FlashVars = ""
Movie = ""
Src = ""
WMode = "Window"
Play = -1 'True
Loop = -1 'True
Quality = "High"
SAlign = ""
Menu = -1 'True
Base = ""
AllowScriptAccess= ""
Scale = "ShowAll"
DeviceFont = 0 'False
EmbedMovie = 0 'False
BGColor = ""
SWRemote = ""
MovieData = ""
SeamlessTabbing = -1 'True
Profile = 0 'False
ProfileAddress = ""
ProfilePort = 0
AllowNetworking = "all"
End
End
Attribute VB_Name = "frmsushe2"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim a(5) As String
Private Sub cobclass_Click()
If Option1.Value = True Then
Option1.Value = False
End If
If Option2.Value = True Then
Option2.Value = False
End If
End Sub
Private Sub cobcollege_Click()
'专业
sql = ""
sql = "select 专业 from Spcollege where 学院='" & cobcollege.Text & "'"
Set adoRS = adoCon.Execute(sql)
cobsp.Clear
Do While Not adoRS.EOF
cobsp.AddItem Trim(adoRS("专业"))
adoRS.MoveNext
Loop
cobsp.ListIndex = 0
End Sub
Private Sub cobsp_Click()
'班级
sql = ""
sql = "select 班级 from Spclass where 专业='" & cobsp.Text & "'"
Set adoRS = adoCon.Execute(sql)
cobclass.Clear
Do While Not adoRS.EOF
cobclass.AddItem Trim(adoRS("班级"))
adoRS.MoveNext
Loop
cobclass.ListIndex = 0
Option1.Value = False
Option2.Value = False
End Sub
Private Sub Command1_Click()
On Error GoTo errMsg
Dim sql As String
sql = "Select * From Room Where 学号='" & Trim(txtnumber1.Text) & "'"
Set adoRS = adoCon.Execute(sql)
If Not adoRS.EOF Then
MsgBox "编号为：" & Trim(txtnumber1.Text) & "的学生已经存在！", vbOKOnly + vbExclamation, "系统提示"
txtnumber1.SetFocus
Exit Sub
End If
'判断学生2
sql = ""
sql = "Select * From Room Where 学号='" & Trim(txtnumber2.Text) & "'"
Set adoRS = adoCon.Execute(sql)
If Not adoRS.EOF Then
MsgBox "编号为：" & Trim(txtnumber2.Text) & "的学生已经存在！", vbOKOnly + vbExclamation, "系统提示"
txtnumber2.SetFocus
Exit Sub
End If
'判断学生3
sql = ""
sql = "Select * From Room Where 学号='" & Trim(txtnumber3.Text) & "'"
Set adoRS = adoCon.Execute(sql)
If Not adoRS.EOF Then
MsgBox "编号为：" & Trim(txtnumber3.Text) & "的学生已经存在！", vbOKOnly + vbExclamation, "系统提示"
txtnumber2.SetFocus
Exit Sub
End If
'判断学生4
sql = ""
sql = "Select * From Room Where 学号='" & Trim(txtnumber4.Text) & "'"
Set adoRS = adoCon.Execute(sql)
If Not adoRS.EOF Then
MsgBox "编号为：" & Trim(txtnumber4.Text) & "的学生已经存在！", vbOKOnly + vbExclamation, "系统提示"
txtnumber2.SetFocus
Exit Sub
End If
'构造语句
If txtname1.Enabled = True Then
sql = ""
sql = "Insert Into Room "
sql = sql & " Values('" & Trim(txtnumber1.Text) & "'"
sql = sql & ",'" & Trim(txtname1.Text) & "'"
sql = sql & ",'" & Trim(txtsex1.Text) & "'"
sql = sql & ",'" & Trim(cobcollege.Text) & "'"
sql = sql & ",'" & Trim(txtsp1.Text) & "'"
sql = sql & ",'" & Trim(txtclass1.Text) & "'"
sql = sql & ",'" & Trim(frmsushe1.fk) & "')"
adoCon.Execute (sql)
End If
'学生2
If txtname2.Enabled = True Then
sql = ""
sql = "Insert Into Room "
sql = sql & " Values('" & Trim(txtnumber2.Text) & "'"
sql = sql & ",'" & Trim(txtname2.Text) & "'"
sql = sql & ",'" & Trim(txtsex2.Text) & "'"
sql = sql & ",'" & Trim(cobcollege.Text) & "'"
sql = sql & ",'" & Trim(txtsp2.Text) & "'"
sql = sql & ",'" & Trim(txtclass2.Text) & "'"
sql = sql & ",'" & Trim(frmsushe1.fk) & "')"
adoCon.Execute (sql)
End If
'学生3
If txtname3.Enabled = True Then
sql = ""
sql = "Insert Into Room "
sql = sql & " Values('" & Trim(txtnumber3.Text) & "'"
sql = sql & ",'" & Trim(txtname3.Text) & "'"
sql = sql & ",'" & Trim(txtsex3.Text) & "'"
sql = sql & ",'" & Trim(cobcollege.Text) & "'"
sql = sql & ",'" & Trim(txtsp3.Text) & "'"
sql = sql & ",'" & Trim(txtclass3.Text) & "'"
sql = sql & ",'" & Trim(frmsushe1.fk) & "')"
adoCon.Execute (sql)
End If
'学生4
If txtname4.Enabled = True Then
sql = ""
sql = "Insert Into Room "
sql = sql & " Values('" & Trim(txtnumber4.Text) & "'"
sql = sql & ",'" & Trim(txtname4.Text) & "'"
sql = sql & ",'" & Trim(txtsex4.Text) & "'"
sql = sql & ",'" & Trim(cobcollege.Text) & "'"
sql = sql & ",'" & Trim(txtsp4.Text) & "'"
sql = sql & ",'" & Trim(txtclass4.Text) & "'"
sql = sql & ",'" & Trim(frmsushe1.fk) & "')"
adoCon.Execute (sql)
End If
MsgBox "录入成功！", vbOKOnly + vbInformation, "成功提示"
fill
errMsg:
If Err.Number <> 0 Then
MsgBox Err.Number & Err.Description, vbOKOnly + vbCritical, "出错提示"
Exit Sub
End If
End Sub
Private Sub Command10_Click()
txtnumber3.Text = ""
txtname3.Text = ""
txtsex3.Text = ""
txtsp3.Text = ""
txtclass3.Text = ""
End Sub
Private Sub Command11_Click()
txtnumber4.Text = ""
txtname4.Text = ""
txtsex4.Text = ""
txtsp4.Text = ""
txtclass4.Text = ""
End Sub
Private Sub Command12_Click(Index As Integer)
If List1.ListIndex < 0 Then
MsgBox "请选择学生！", vbOKOnly + vbExclamation, "系统提示"
Exit Sub
End If
Select Case Index
Case 0
'学生1
If Option1.Value = True Then
sql = "select * from Student where ID='" & Trim(List1.Text) & "'"
End If
If Option2.Value = True Then
sql = "select * from Student where Name='" & Trim(List1.Text) & "'"
End If
Set adoRS = adoCon.Execute(sql)
If adoRS.EOF Then
MsgBox "对不起，查无此人，请执行系统查询功能，" _
& vbCrLf & vbCrLf & "确认要录入宿舍的学号后再进行录入。", _
vbInformation + vbOKOnly, "系统提示"
Exit Sub
Else
txtclass1.Enabled = True
txtclass1.BackColor = &H80000005
a(0) = txtclass1.Text
txtclass1.Text = Trim(adoRS("Class"))
txtsp1.Enabled = True
txtsp1.BackColor = &H80000005
a(1) = txtsp1.Text
txtsp1.Text = Trim(adoRS("Speciality"))
txtsp1.BackColor = &H80000005
txtsex1.Enabled = True
txtsex1.BackColor = &H80000005
a(2) = txtsex1.Text
txtsex1.Text = Trim(adoRS("Sex"))
txtname1.Enabled = True
txtname1.BackColor = &H80000005
a(3) = txtname1.Text
txtname1.Text = Trim(adoRS("Name"))
txtnumber1.Enabled = True
txtnumber1.BackColor = &H80000005
a(4) = txtnumber1.Text
txtnumber1.Text = Trim(adoRS("ID"))
Command8.Enabled = True
End If
If txtnumber1.Text = txtnumber2.Text Or txtnumber1.Text = txtnumber3.Text Or txtnumber4.Text = txtnumber1.Text Then
txtclass1.Text = a(0)
txtsp1.Text = a(1)
txtsex1.Text = a(2)
txtname1.Text = a(3)
txtnumber1.Text = a(4)
If a(0) = "" Then
txtclass1.Enabled = False
txtsp1.Enabled = False
txtsex1.Enabled = False
txtname1.Enabled = False
Command8.Enabled = False
txtname1.BackColor = &H80000013
txtsex1.BackColor = &H80000013
txtsp1.BackColor = &H80000013
txtclass1.BackColor = &H80000013
End If
MsgBox "学生不能重复，请核实！", vbOKOnly + vbExclamation, "系统提示"
End If
Set adoRS = Nothing
Case 1
'学生2
If Option1.Value = True Then
sql = "select * from Student where ID='" & Trim(List1.Text) & "'"
End If
If Option2.Value = True Then
sql = "select * from Student where Name='" & Trim(List1.Text) & "'"
End If
Set adoRS = adoCon.Execute(sql)
If adoRS.EOF Then
MsgBox "对不起，查无此人，请执行系统查询功能，" _
& vbCrLf & vbCrLf & "确认要录入宿舍的学号后再进行录入。", _
vbInformation + vbOKOnly, "系统提示"
Exit Sub
Else
txtclass2.Enabled = True
txtclass2.BackColor = &H80000005
a(0) = txtclass2.Text
txtclass2.Text = Trim(adoRS("Class"))
txtsp2.Enabled = True
txtsp2.BackColor = &H80000005
a(1) = txtsp2.Text
txtsp2.Text = Trim(adoRS("Speciality"))
txtsp2.BackColor = &H80000005
txtsex2.Enabled = True
txtsex2.BackColor = &H80000005
a(2) = txtsex2.Text
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -