📄 teamsinfo.frm
字号:
VERSION 5.00
Begin VB.Form TeamsInfo
BorderStyle = 1 'Fixed Single
Caption = "班组信息"
ClientHeight = 1995
ClientLeft = 45
ClientTop = 435
ClientWidth = 4515
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 1995
ScaleWidth = 4515
StartUpPosition = 3 '窗口缺省
Begin VB.ComboBox Bz
Height = 300
Left = 1320
TabIndex = 6
Top = 800
Width = 2775
End
Begin VB.ComboBox bm
Height = 300
Left = 1320
TabIndex = 4
Top = 240
Width = 2775
End
Begin VB.CommandButton Command1
Caption = "添加"
Height = 375
Left = 360
TabIndex = 2
Top = 1320
Width = 1095
End
Begin VB.CommandButton Command2
Caption = "删除"
Height = 375
Left = 1680
TabIndex = 1
Top = 1320
Width = 1095
End
Begin VB.CommandButton Command3
Caption = "退出"
Height = 375
Left = 3000
TabIndex = 0
Top = 1320
Width = 1095
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "班组名称"
Height = 180
Left = 360
TabIndex = 5
Top = 840
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "部门选择"
Height = 180
Left = 360
TabIndex = 3
Top = 320
Width = 720
End
End
Attribute VB_Name = "TeamsInfo"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub BM_Click()
TeamsToCombo BZ, BM.Text
End Sub
Private Sub Command1_Click()
AddTeams BZ.Text
TeamsToCombo BZ, BM.Text
End Sub
Private Sub Command2_Click()
DelTeams BZ.Text
TeamsToCombo BZ, BM.Text
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Form_Load()
Me.Left = (Screen.Width - Me.Width) / 2
Me.Top = (Screen.Height - Me.Height) / 2
DepartToCombo BM
ConvertFont Me
End Sub
Private Sub DelTeams(txt As String)
If MsgBox("是否确定删除", vbInformation Or vbYesNo, "提示") = vbYes Then
If AssertTeamsOK(txt) = True Then
SQL = "delete from 班组信息 where 部门名称='" & BM.Text & "' and 班组名称='" & txt & "'"
If rs.State = 1 Then rs.Close
rs.Open SQL, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
MsgBox "删除完成", vbInformation, "提示"
End If
End If
End Sub
Private Sub AddTeams(txt As String)
If MsgBox("是否确定添加", vbInformation Or vbYesNo, "提示") = vbYes Then
If AssertTeamsOK(txt) = False Then
If rs.State = 1 Then rs.Close
rs.Open "班组信息", DBConn, adOpenKeyset, adLockOptimistic, adCmdTable
rs.AddNew
rs.Fields("部门名称").Value = BM.Text
rs.Fields("班组名称").Value = txt
rs.Update
MsgBox "添加完成", vbInformation, "提示"
End If
End If
End Sub
Private Function AssertTeamsOK(txt As String) As Boolean
SQL = "Select * from 班组信息 where 部门名称='" & BM.Text & "' and 班组名称='" & txt & "'"
If rs.State = 1 Then rs.Close
rs.Open SQL, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
If Not rs.EOF Then
AssertTeamsOK = True
Else
AssertTeamsOK = False
End If
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -