📄 frmkhwh.frm
字号:
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 = 23
Top = 1680
Width = 1695
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 = 22
Top = 3360
Width = 1455
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 = 21
Top = 4200
Width = 1455
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 = 20
Top = 5040
Width = 1575
End
Begin VB.Label Label9
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 = 19
Top = 2520
Width = 1695
End
Begin VB.Label Label10
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 = 18
Top = 2520
Width = 1815
End
Begin VB.Label Label11
Caption = "E-mail:"
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 = 17
Top = 3360
Width = 1215
End
Begin VB.Label Label12
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 = 5400
TabIndex = 16
Top = 4200
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 = "frmkhwh"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
txtid.Enabled = True
txtid.Locked = False
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 txtid.Text = "" Then
If MsgBox("编号不能为空,请重新输入!", 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 MsgBox("请确认填写无误,否则修改!", vbOKCancel, "提示") = vbOK Then
If cx = True Then
With rs
.Edit
.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()
On Error GoTo a
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 txtid.Text = "" Then
If MsgBox("客户编号不能为空,请重新输入!", 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
txtdw.Text = rs.Fields("单位名称")
txtjc.Text = rs.Fields("客户简称")
txtdz.Text = rs.Fields("客户地址")
txtxm.Text = rs.Fields("负责人姓名")
txtsfz.Text = rs.Fields("身份证/护照")
txtdh.Text = rs.Fields("电话号码")
txtem.Text = rs.Fields("E-mail地址")
txtsj.Text = rs.Fields("手机号码")
txtwz.Text = rs.Fields("网址")
txtcz.Text = rs.Fields("传真号码")
txtbz.Text = rs.Fields("备注")
txtid.Locked = True
Else
MsgBox "此客户编号不存在,请重新输入!", vbCritical, "错误"
txtid.Text = ""
txtid.SetFocus
End If
End If
rs.Close
db.Close
a:
If Err.Number = 94 Then
txtdw.SetFocus
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -