📄 frmzjkh.frm
字号:
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 360
TabIndex = 24
Top = 2400
Width = 1695
End
Begin VB.Label Label8
Caption = "传真号码:"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 495
Left = 360
TabIndex = 23
Top = 4920
Width = 1575
End
Begin VB.Label Label7
Caption = "手机号码:"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 495
Left = 360
TabIndex = 22
Top = 4080
Width = 1455
End
Begin VB.Label Label6
Caption = "电话号码:"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 360
TabIndex = 21
Top = 3240
Width = 1455
End
Begin VB.Label Label5
Caption = "客户地址:"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 495
Left = 4440
TabIndex = 20
Top = 1560
Width = 1695
End
Begin VB.Label Label3
Caption = "单位名称："
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 615
Left = 4440
TabIndex = 19
Top = 720
Width = 1455
End
Begin VB.Label Label2
Caption = "客户简称："
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 495
Left = 360
TabIndex = 18
Top = 1560
Width = 1455
End
Begin VB.Label Label1
Caption = "客户编号:"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 495
Left = 360
TabIndex = 17
Top = 720
Width = 1455
End
Begin VB.Label Label4
Caption = "备 注:"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 5400
TabIndex = 16
Top = 4920
Width = 1095
End
End
Begin VB.Label Label13
Caption = "操 作 员:"
BeginProperty Font
Name = "宋体"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 8040
TabIndex = 29
Top = 8040
Width = 1575
End
End
Attribute VB_Name = "frmzjkh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
txtid.Enabled = True
txtdw.Enabled = True
txtjc.Enabled = True
txtdz.Enabled = True
txtxm.Enabled = True
txtsfz.Enabled = True
txtdh.Enabled = True
txtem.Enabled = True
txtsj.Enabled = True
txtwz.Enabled = True
txtcz.Enabled = True
txtbz.Enabled = True
Command2.Enabled = True
txtid.SetFocus
Command1.Enabled = False
End Sub
Private Sub Command2_Click()
DefaultType = dbUseODBC
Dim db As Database
Dim rs As Recordset
Dim cx As Boolean
Dim wk As Workspace
Set wk = DBEngine.Workspaces(0)
cx = False
Set db = OpenDatabase("xsys", dbDriverNoPrompt, False, "odbc;database=glxt;uid=;pwd=;dsn=xsys")
wk.BeginTrans
Set rs = db.OpenRecordset("khk", dbOpenDynaset, dbwrite, dbOptimistic)
If Len(txtid.Text) < 4 Then
If MsgBox("编号长度不能小于4位,请重新输入!", vbOKCancel, "错误") = vbOK Then
Command3.SetFocus
Else
Command3.SetFocus
End If
Else
rs.MoveFirst
Do While rs.EOF <> True
If rs.Fields("客户编号") = Trim(txtid.Text) Then
cx = True
Exit Do
Else
rs.MoveNext
End If
Loop
If MsgBox("请确认填写无误,否则修改!", vbOKCancel, "提示") = vbOK Then
If cx = False Then
With rs
.AddNew
.Fields("客户编号") = Trim(txtid.Text)
.Fields("单位名称") = Trim(txtdw.Text)
.Fields("客户简称") = Trim(txtjc.Text)
.Fields("客户地址") = Trim(txtdz.Text)
.Fields("电话号码") = Trim(txtdh.Text)
.Fields("手机号码") = Trim(txtsj.Text)
.Fields("传真号码") = Trim(txtcz.Text)
.Fields("E-mail地址") = Trim(txtem.Text)
.Fields("网址") = Trim(txtwz.Text)
.Fields("负责人姓名") = Trim(txtxm.Text)
.Fields("身份证/护照") = Trim(txtsfz.Text)
.Fields("备注") = Trim(txtbz.Text)
.Update
End With
wk.CommitTrans
txtid.Text = ""
txtdw.Text = ""
txtjc.Text = ""
txtdz.Text = ""
txtxm.Text = ""
txtsfz.Text = ""
txtdh.Text = ""
txtem.Text = ""
txtsj.Text = ""
txtwz.Text = ""
txtcz.Text = ""
txtbz.Text = ""
Command2.Enabled = False
Command1.Enabled = True
txtid.Enabled = False
txtdw.Enabled = False
txtjc.Enabled = False
txtdz.Enabled = False
txtxm.Enabled = False
txtsfz.Enabled = False
txtdh.Enabled = False
txtem.Enabled = False
txtsj.Enabled = False
txtwz.Enabled = False
txtcz.Enabled = False
txtbz.Enabled = False
Else
MsgBox "此客户编号已存在,请重新输入!", vbCritical, "错误"
txtid.Text = ""
txtid.SetFocus
End If
Else
txtid.SetFocus
End If
rs.Close
db.Close
End If
End Sub
Private Sub Command3_Click()
Unload Me
frmmenu.Show
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer)
Dim nexttabindex As Integer, i As Integer
If KeyAscii = 13 Then
If Screen.ActiveControl.TabIndex = Count - 1 Then
nexttabindex = 0
Else
nexttabindex = Screen.ActiveControl.TabIndex + 1
End If
For i = 0 To Count - 1
If Me.Controls(i).TabIndex = nexttabindex Then
Me.Controls(i).SetFocus
Exit For
End If
If nexttabindex = 12 Then
Command2.SetFocus
Exit For
End If
Next i
KeyAscii = 0
End If
End Sub
Private Sub Form_Load()
txtid.Enabled = False
txtdw.Enabled = False
txtjc.Enabled = False
txtdz.Enabled = False
txtxm.Enabled = False
txtsfz.Enabled = False
txtdh.Enabled = False
txtem.Enabled = False
txtsj.Enabled = False
txtwz.Enabled = False
txtcz.Enabled = False
txtbz.Enabled = False
txtczy.Text = frmlogin.Combo1.Text
txtczy.Locked = True
Command2.Enabled = False
End Sub
Private Sub txtid_LostFocus()
DefaultType = dbUseODBC
Dim db As Database
Dim rs As Recordset
Dim cx As Boolean
cx = False
Set db = OpenDatabase("xsys", dbDriverNoPrompt, False, "odbc;database=glxt;uid=;pwd=;dsn=xsys")
Set rs = db.OpenRecordset("khk", dbOpenDynaset, dbwrite, dbOptimistic)
If Len(txtid.Text) <> 4 Then
If MsgBox("客户编号长度只能等于4位,请重新输入!", vbOKCancel, "错误") = vbOK Then
Command3.SetFocus
Else
Command3.SetFocus
End If
Else
rs.MoveFirst
Do While rs.EOF <> True
If rs.Fields("客户编号") = LTrim(txtid.Text) Then
cx = True
Exit Do
Else
rs.MoveNext
End If
Loop
If cx = True Then
MsgBox "此客户编号已存在,请重新输入!", vbCritical, "错误"
txtid.Text = ""
txtid.SetFocus
End If
End If
rs.Close
db.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -