📄 frmpeople.frm
字号:
VERSION 5.00
Begin VB.Form frmPeople
Caption = "人员资料"
ClientHeight = 6150
ClientLeft = 60
ClientTop = 450
ClientWidth = 4455
Icon = "frmPeople.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
ScaleHeight = 6150
ScaleWidth = 4455
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command2
Caption = "退出(&E)"
Height = 345
Left = 2340
TabIndex = 18
Top = 5640
Width = 1215
End
Begin VB.CommandButton Command1
Caption = "保存(&S)"
Height = 345
Left = 900
TabIndex = 17
Top = 5640
Width = 1215
End
Begin VB.Frame Frame1
Height = 5505
Left = 90
TabIndex = 0
Top = -30
Width = 4275
Begin VB.ComboBox Combo1
Height = 315
Left = 1200
TabIndex = 19
Top = 2370
Width = 2115
End
Begin VB.OptionButton Option1
Caption = "女"
Height = 315
Index = 1
Left = 2400
TabIndex = 16
Top = 1170
Width = 735
End
Begin VB.OptionButton Option1
Caption = "男"
Height = 315
Index = 0
Left = 1500
TabIndex = 15
Top = 1170
Value = -1 'True
Width = 735
End
Begin VB.TextBox txtField
Height = 1905
Index = 5
Left = 180
MaxLength = 200
TabIndex = 14
Top = 3450
Width = 3855
End
Begin VB.TextBox txtField
Height = 345
Index = 4
Left = 1200
MaxLength = 20
TabIndex = 13
Top = 2760
Width = 2655
End
Begin VB.TextBox txtField
Height = 345
Index = 3
Left = 1200
MaxLength = 2
TabIndex = 12
Top = 1965
Width = 2655
End
Begin VB.TextBox txtField
Height = 345
Index = 2
Left = 1200
MaxLength = 2
TabIndex = 11
Top = 1575
Width = 2655
End
Begin VB.TextBox txtField
Height = 345
Index = 1
Left = 1200
MaxLength = 20
TabIndex = 10
Top = 750
Width = 2655
End
Begin VB.TextBox txtField
Height = 345
Index = 0
Left = 1200
MaxLength = 20
TabIndex = 9
Top = 360
Width = 2655
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "备注："
Height = 195
Index = 7
Left = 480
TabIndex = 8
Top = 3180
Width = 540
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "职务："
Height = 195
Index = 6
Left = 480
TabIndex = 7
Top = 2850
Width = 540
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "部门："
Height = 195
Index = 5
Left = 480
TabIndex = 6
Top = 2445
Width = 540
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "工龄："
Height = 195
Index = 4
Left = 480
TabIndex = 5
Top = 2040
Width = 540
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "年龄："
Height = 195
Index = 3
Left = 480
TabIndex = 4
Top = 1635
Width = 540
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "性别："
Height = 195
Index = 2
Left = 480
TabIndex = 3
Top = 1230
Width = 540
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "姓名："
Height = 195
Index = 1
Left = 480
TabIndex = 2
Top = 825
Width = 540
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
AutoSize = -1 'True
Caption = "编号："
Height = 195
Index = 0
Left = 480
TabIndex = 1
Top = 420
Width = 540
End
End
End
Attribute VB_Name = "frmPeople"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Public blIsEdit As Boolean
Dim rsWrite As New ADODB.Recordset
Private Sub Combo1_KeyPress(KeyAscii As Integer)
KeyAscii = 0
End Sub
Private Sub Command1_Click()
Dim sField0 As String, sField1 As String, sSex As String
Dim iField2 As Integer, iField3 As Integer
Dim sField4 As String, sField5 As String, sField6 As String
Dim I As Integer
Dim strSql As String
On Error GoTo err_lab
sField0 = Me.txtField(0).Text
sField1 = Me.txtField(1).Text
If Me.Option1(0).Value = True Then
sSex = "男"
Else
sSex = "女"
End If
iField2 = Val(Me.txtField(2).Text)
iField3 = Val(Me.txtField(3).Text)
sField4 = Me.Combo1.Text
sField5 = Me.txtField(4).Text
sField6 = Me.txtField(5).Text
If blIsEdit Then
'修改
strSql = "update tbl_User set UserName='" & sField1 & "'," _
& "sex='" & sSex & "',age=" & iField2 & ",gl=" & iField3 & "," _
& "department='" & sField4 & "',business='" & sField5 & "',remark='" _
& sField6 & "' where UserID='" & sField0 & "'"
gblCn.Execute strSql
MsgBox "修改完毕！", vbInformation + vbOKOnly, "提示"
Else
'新增
Set rsWrite = Nothing
strSql = "select * from tbl_User where UserID='" & sField0 & "'"
rsWrite.Open strSql, gblCn, adOpenKeyset, adLockOptimistic, adCmdText
If rsWrite.RecordCount > 0 Then
MsgBox "已经存在当前的用户编号！", vbInformation + vbOKOnly, "提示"
Exit Sub
Else
rsWrite.AddNew
rsWrite.Fields("UserID") = sField0
rsWrite.Fields("UserName") = sField1
rsWrite.Fields("sex") = sSex
rsWrite.Fields("age") = iField2
rsWrite.Fields("gl") = iField3
rsWrite.Fields("department") = sField4
rsWrite.Fields("business") = sField5
rsWrite.Fields("remark") = sField6
rsWrite.Update
End If
rsWrite.Close
MsgBox "新增完毕！", vbInformation + vbOKOnly, "提示"
For I = 0 To 5
Me.txtField(I).Text = ""
Next
Me.Option1(0).Value = True
End If
frmUserView.InitTreeView
frmUserView.LoadListItemData "ALL"
Exit Sub
err_lab:
MsgBox Err.Description, vbInformation + vbOKOnly, "提示"
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Load_Department
End Sub
Private Sub Form_Resize()
On Error Resume Next
Me.Height = 6660
Me.Width = 4575
End Sub
'加载部门
Sub Load_Department()
Me.Combo1.Clear
Set rsWrite = Nothing
rsWrite.Open "select Department from tbl_Department order by id", gblCn, adOpenKeyset, adLockOptimistic, adCmdText
Do Until rsWrite.EOF
Me.Combo1.AddItem rsWrite("department")
rsWrite.MoveNext
Loop
rsWrite.Close
End Sub
Private Sub txtField_KeyPress(Index As Integer, KeyAscii As Integer)
Select Case Index
Case 2, 3
If KeyAscii >= 48 And KeyAscii <= 57 Then
ElseIf KeyAscii = vbKeyBack Then
Else
KeyAscii = 0
End If
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -