📄 frmclass.frm
字号:
TabIndex = 12
Top = 315
Width = 1695
_ExtentX = 2990
_ExtentY = 582
_Version = 393216
Style = 2
Text = ""
End
End
Begin MSDataGridLib.DataGrid DataGrid1
Height = 2535
Left = 120
TabIndex = 3
Top = 2160
Width = 9135
_ExtentX = 16113
_ExtentY = 4471
_Version = 393216
AllowUpdate = 0 'False
AllowArrows = 0 'False
HeadLines = 1
RowHeight = 15
BeginProperty HeadFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ColumnCount = 2
BeginProperty Column00
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
BeginProperty Column01
DataField = ""
Caption = ""
BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED}
Type = 0
Format = ""
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 0
EndProperty
EndProperty
SplitCount = 1
BeginProperty Split0
BeginProperty Column00
EndProperty
BeginProperty Column01
EndProperty
EndProperty
End
Begin VB.Frame Frame1
Caption = "班级信息"
Height = 1575
Left = 120
TabIndex = 2
Top = 480
Width = 9135
Begin VB.ComboBox txtFudaoyuan
Height = 315
ItemData = "frmClass.frx":0054
Left = 1080
List = "frmClass.frx":0064
Style = 2 'Dropdown List
TabIndex = 33
Top = 960
Width = 1815
End
Begin VB.TextBox txtRenshu
Height = 320
Left = 6720
TabIndex = 29
Top = 960
Width = 1815
End
Begin VB.CommandButton cmdADD
Caption = "添 加"
Height = 330
Left = 7560
TabIndex = 8
Top = 360
Width = 1215
End
Begin VB.TextBox txtJiaoshi
Height = 320
Left = 3720
TabIndex = 7
Top = 960
Width = 1815
End
Begin MSDataListLib.DataCombo txtZuanye
Height = 315
Left = 4080
TabIndex = 6
Top = 360
Width = 2055
_ExtentX = 3625
_ExtentY = 582
_Version = 393216
Style = 2
Text = ""
End
Begin VB.TextBox txtClass
Height = 285
Left = 1120
TabIndex = 5
Top = 360
Width = 1455
End
Begin VB.Label Label6
Caption = "辅 导 员 教室 人数"
Height = 255
Left = 240
TabIndex = 21
Top = 1080
Width = 6375
End
Begin VB.Label Label2
BackStyle = 0 'Transparent
Caption = "班级名称 所属院系"
Height = 255
Left = 240
TabIndex = 4
Top = 480
Width = 3735
End
End
End
Begin VB.Line Line1
BorderColor = &H00000000&
X1 = 0
X2 = 9360
Y1 = 600
Y2 = 600
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "班 级 管 理"
BeginProperty Font
Name = "黑体"
Size = 21.75
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 435
Left = 3480
TabIndex = 0
Top = 120
Width = 2520
End
End
Attribute VB_Name = "frmClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private conn As ADODB.Connection
Private rsBJ As ADODB.Recordset
Private rsZY As ADODB.Recordset
Private rs As ADODB.Recordset
Private Sub cmdADD_Click()
If Trim(txtClass.Text = "") Or Trim(txtZuanye.Text = "") Or Trim(txtFudaoyuan.Text = "") Or Trim(txtJiaoshi.Text = "") Or Trim(txtRenshu.Text = "") Then
MsgBox "请输入完整的班级信息！", vbOKOnly + vbQuestion, "提示"
Else
addClassInfo '添加班级
End If
End Sub
Private Sub cmdChange_Click()
If cmdChange.Caption = "修改" Then
cmdChange.Caption = "确认修改"
For i = 0 To 4
Text1(i).Enabled = True
Next
Else
cmdChange.Caption = "修改"
For i = 0 To 4
Text1(i).Enabled = False
Next
'-------------------------修改记录
rsBJ.Fields(1) = Trim(Text1(1).Text)
rsBJ.Fields(2) = Trim(Text1(2).Text)
rsBJ.Fields(3) = Trim(Text1(3).Text)
rsBJ.Fields(4) = Trim(Text1(4).Text)
rsBJ.Update
rsBJ.MoveFirst
DataGrid1.Refresh
DataGrid2.Refresh
DataGrid3.Refresh
Command2_Click
End If
End Sub
Private Sub cmdDelBJ_Click()
i = MsgBox("是否确认要删除该班级信息！", vbYesNo + vbInformation, "提示")
On Error Resume Next
If i = vbYes Then
rsBJ.Delete
rsBJ.MoveNext
DataGrid3.Refresh
End If
End Sub
Private Sub Command1_Click()
If OptBj.Value And txtFindBj.Text = "" Then MsgBox "请选择班级！", vbOKOnly + vbInformation, "提示": Exit Sub
If OptJs.Value And txtFindFdy.Text = "" Then MsgBox "请选择辅导员！", vbOKOnly + vbInformation, "提示": Exit Sub
Dim txtSQL As String
If OptBj.Value Then
txtSQL = "select * from xsBJ where 班级名称='" & txtFindBj.Text & "'"
Else
txtSQL = "select * from xsBJ where 辅导员='" & txtFindFdy.Text & "'"
End If
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open txtSQL, conn, 1, 1
Set DataGrid2.DataSource = rs
DataGrid2.Refresh
For i = 0 To 4
Set Text1(i).DataSource = rs
Next
End Sub
Private Sub Command2_Click()
Set DataGrid2.DataSource = rsBJ
DataGrid2.Refresh
For i = 0 To 4
Set Text1(i).DataSource = rsBJ
Next
End Sub
Private Sub Command6_Click()
rsBJ.Close
rsZY.Close
conn.Close
Unload Me
End Sub
Private Sub Form_Activate()
Set conn = New ADODB.Connection
conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\xs.mdb"
conn.Open
Set rsBJ = New ADODB.Recordset '设置链接班级
rsBJ.CursorLocation = adUseClient
rsBJ.Open "xsBJ", conn, 2, 2
Set rs = New ADODB.Recordset
rs.Open "xsBJ", conn, 1, 1
Set txtFindBj.RowSource = rsBJ
txtFindBj.ListField = "班级名称"
Set txtDelBj.RowSource = rsBJ
txtDelBj.ListField = "班级名称"
Set txtFindFdy.RowSource = rsBJ
txtFindFdy.ListField = "辅导员"
Set rsZY = New ADODB.Recordset '链接专业
rsZY.CursorLocation = adUseClient
rsZY.Open "xsZY", conn, 1, 1
Set txtZuanye.RowSource = rsZY
txtZuanye.ListField = "所属院系"
Set DataGrid1.DataSource = rsBJ
DataGrid1.Refresh
Set DataGrid2.DataSource = rsBJ
DataGrid2.Refresh
Set DataGrid3.DataSource = rsBJ
DataGrid3.Refresh
Set txtDelBj.DataSource = rsBJ
txtDelBj.DataField = "班级名称"
For i = 0 To 4 '设制修改班级信息的,字段链接
Set Text1(i).DataSource = rsBJ
Next
Text1(0).DataField = "班级名称"
Text1(1).DataField = "所属院系"
Text1(2).DataField = "辅导员"
Text1(3).DataField = "教室"
Text1(4).DataField = "人数"
End Sub
Sub addClassInfo() '添加班级
Dim txtSQL As String
txtSQL = "select * from xsBJ where 班级名称='" & Trim(txtClass.Text) & "'"
Set rs = New ADODB.Recordset
rs.CursorLocation = adUseClient
rs.Open txtSQL, conn, 2, 2
If rs.EOF = False Then
MsgBox "库中已经存在名为：" & txtClass.Text & " 的班级，请重新输入！", vbOKOnly + vbInformation, "提示"
txtClass.Text = ""
txtClass.SetFocus
Else
rsBJ.AddNew
rsBJ.Fields(0) = Trim(txtClass.Text)
rsBJ.Fields(1) = Trim(txtZuanye.Text)
rsBJ.Fields(2) = txtFudaoyuan.Text
rsBJ.Fields(3) = Trim(txtJiaoshi.Text)
rsBJ.Fields(4) = Trim(txtRenshu.Text) & "人"
rsBJ.Update
DataGrid1.Refresh
DataGrid2.Refresh
DataGrid3.Refresh
rsBJ.MoveFirst
MsgBox "班级添加成功！", vbOKOnly + vbInformation, "提示"
txtClass.Text = "": txtZuanye.Text = "": txtJiaoshi.Text = "": txtRenshu.Text = ""
End If
End Sub
Private Sub OptBj_Click()
If OptBj.Value Then
txtFindBj.Enabled = True
txtFindFdy.Enabled = False: txtFindFdy.Text = ""
txtFindBj.SetFocus
Set DataGrid2.DataSource = rsBJ
DataGrid2.Refresh
For i = 0 To 4
Set Text1(i).DataSource = rsBJ
Next
End If
End Sub
Private Sub OptJs_Click()
If OptJs.Value Then
txtFindFdy.Enabled = True
txtFindFdy.SetFocus
txtFindBj.Enabled = False: txtFindBj.Text = ""
txtFindFdy.SetFocus
Set DataGrid2.DataSource = rsBJ
DataGrid2.Refresh
End If
For i = 0 To 4
Set Text1(i).DataSource = rsBJ
Next
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -