📄
字号:
.Fields("Address") = Trim(LrText(4).Text) '地址
.Fields("postcode") = Trim(LrText(5)) '邮编
.Fields("taxcode") = Trim(LrText(6)) '税号
.Fields("fictperson") = Trim(LrText(7)) '法人
.Fields("bank") = Trim(LrText(8).Text) '开户银行
.Fields("bankaccount") = Trim(LrText(9).Text) '银行账号
.Fields("Cussuper") = Trim(LrText(10).Text) '上级主管公司
.Fields("email") = Trim(LrText(11).Text) 'email
.Fields("worknet") = Trim(LrText(12).Text) '网址
.Fields("contactperson") = Trim(LrText(13).Text) '联系人
.Fields("contacttype") = Trim(LrText(14).Text) '联系方式
.Fields("desaddress") = Trim(LrText(15).Text) '收获地址
.Fields("creditgrade") = Trim(LrText(16).Text) '信用等级
.Fields("creditmoney") = Val(LrText(17).Text) '信用额度
.Fields("creditagemoney") = Val(LrText(18).Text) '帐龄额度
If IsDate(LrText(19).Text) Then
.Fields("creditdate") = Trim(LrText(19).Text) '信用天数
End If
If Trim(LrText(25).Tag) <> "" Then '公司分管部门
.Fields("deptcode") = Trim(LrText(25).Tag)
Else
.Fields("deptcode") = Null
End If
If Trim(LrText(26).Tag) <> "" Then '所属销售员
.Fields("PersonCode") = Trim(LrText(26).Tag)
Else
.Fields("PersonCode") = Null
End If
If IsDate(LrText(27)) Then '发展日期
.Fields("relationdate") = LrText(27)
Else
.Fields("relationdate") = Null
End If
If ChkStopUse.Value Then '停用标志
.Fields("stopflag") = 1
Else
.Fields("stopflag") = 0
End If
.Update
Cw_DataEnvi.DataConnect.CommitTrans
'将记录加入网格
Sqlstr = "SELECT * FROM Gy_V_Customer WHERE CusCode= '" + Trim(LrText(0).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With CzxsGrid
.AddItem ""
.RowHeight(.Rows - 1) = Sjhgd
.Select .Rows - 1, Qslz
Call Jltcwg(Cxnrrec, .Rows - 1)
End With
Tsxx = "保存完毕!"
Call Xtxxts(Tsxx, 0, 4)
Call Cshlrxx(1)
LrText(0).SetFocus
'将网格按编码排序
With CzxsGrid
.Col = Sydz("001", GridStr(), Szzls)
CzxsGrid.Sort = flexSortStringAscending
End With
'<<]
Else '否则为修改记录
'******************************************
'计算客户名称相似率（相同字的个数/长度）
If Trim(LrText(1)) <> str_cusname Then '如果客户名称改变
str_cusname = ""
likenum = 0
j = 0
'rs用于取出相似率
rs.Open "select itemvalue from gy_accinformation where itemcode='gy_customer'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If .State = 1 Then .Close
.Open "SELECT cusname FROM Gy_Customer where cuscode<>'" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
str_tmp = Trim(LrText(1))
Do While Not .EOF
For I = 1 To Len(str_tmp)
If InStr(1, Trim(.Fields("cusname")), Mid(str_tmp, I, 1)) Then
likenum = likenum + 1
End If
Next
If likenum * 100# / Len(str_tmp) > Val(rs("itemvalue")) Then
Cusname = Cusname & " " & Trim(.Fields("cusname")) & " " & Chr(13)
End If
likenum = 0
.MoveNext
Loop
If Len(Cusname) > 0 Then
Tsxx = "存在相似的客户名称:" & Chr(13) & suppliername & "要继续吗?"
If Xtxxts(Tsxx, 1, 2) = vbNo Then
LrText(1).SetFocus
Bclrsj = False
Exit Function
End If
End If
Set rs = Nothing
End If
'****************************************************
On Error GoTo Swcwcl
Cw_DataEnvi.DataConnect.BeginTrans
If .State = 1 Then .Close
.Open "SELECT * FROM Gy_Customer WHERE CusCode= '" + Trim(LrText(0).Text) + "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not .EOF Then
.Fields("CusName") = Trim(LrText(1).Text) '客户名称
If Trim(LrText(2).Tag) <> "" Then '地区编码
.Fields("Areacode") = Trim(LrText(2).Tag)
Else
.Fields("Areacode") = Null
End If
If Trim(LrText(3).Tag) <> "" Then '行业编码
.Fields("Tradecode") = Trim(LrText(3).Tag)
Else
.Fields("Tradecode") = Null
End If
.Fields("Address") = Trim(LrText(4).Text) '地址
.Fields("postcode") = Trim(LrText(5)) '邮编
.Fields("taxcode") = Trim(LrText(6)) '税号
.Fields("fictperson") = Trim(LrText(7)) '法人
.Fields("bank") = Trim(LrText(8).Text) '开户银行
.Fields("bankaccount") = Trim(LrText(9).Text) '银行账号
.Fields("Cussuper") = Trim(LrText(10).Text) '上级主管公司
.Fields("email") = Trim(LrText(11).Text) 'email
.Fields("worknet") = Trim(LrText(12).Text) '网址
.Fields("contactperson") = Trim(LrText(13).Text) '联系人
.Fields("contacttype") = Trim(LrText(14).Text) '联系方式
.Fields("desaddress") = Trim(LrText(15).Text) '收获地址
.Fields("creditgrade") = Trim(LrText(16).Text) '信用等级
.Fields("creditmoney") = Val(LrText(17).Text) '信用额度
.Fields("creditagemoney") = Val(LrText(18).Text) '帐龄额度
If IsDate(LrText(19).Text) Then
.Fields("creditdate") = Trim(LrText(19).Text) '信用天数
End If
If Trim(LrText(25).Tag) <> "" Then '公司分管部门
.Fields("deptcode") = Trim(LrText(25).Tag)
Else
.Fields("deptcode") = Null
End If
If Trim(LrText(26).Tag) <> "" Then '所属销售员
.Fields("PersonCode") = Trim(LrText(26).Tag)
Else
.Fields("PersonCode") = Null
End If
If IsDate(LrText(27)) Then '发展日期
.Fields("relationdate") = LrText(27)
Else
.Fields("relationdate") = Null
End If
If ChkStopUse.Value Then '停用标志
.Fields("stopflag") = 1
Else
.Fields("stopflag") = 0
End If
.Update
End If
Cw_DataEnvi.DataConnect.CommitTrans
'刷新当前网格
Sqlstr = "SELECT * FROM Gy_V_Customer WHERE CusCode= '" + Trim(LrText(0).Text) + "'"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With CzxsGrid
Call Jltcwg(Cxnrrec, .Row)
End With
End If
'保存记录成功,函数返回真值
Bclrsj = True
Exit Function
End With
Swcwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
Call Xtxxts(Tsxx, 0, 1)
Exit Function
End Function
Private Function Cshlrxx(lrztxx As Integer) As Boolean '初始化录入字段信息
Dim RecTemp As New ADODB.Recordset
TextChangeLock = True '关闭文本框Chang事件
Call mmkn
str_cusname = ""
If lrztxx = 1 Then
'增加新记录时将文本框清空
For Jsqte = 0 To Max_Text_Index
If Len(Trim(Textstr(Jsqte, 1))) <> 0 Then
LrText(Jsqte).Text = ""
LrText(Jsqte).Tag = ""
End If
TextValiJudgeLock(Jsqte) = True
Next Jsqte
'[>>
'在此处可添加新增记录时初始化设置
'<<]
Else
'修改记录时根据记录关键字(编码)从数据表中读入其他字段内容
With RecTemp
Sqlstr = "SELECT * FROM Gy_V_Customer Where CusCode='" & Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
'记录如存在则读入其内容,否则提示记录已被其他人删除
If Not RecTemp.EOF Then
Call ShowData(RecTemp)
Else
Tsxx = "该记录已经被其他人删除,请刷新当前数据!"
Call Xtxxts(Tsxx, 0, 4)
Call Cancel
TextChangeLock = False
Exit Function
End If
End With
End If
Cshlrxx = True
TextChangeLock = False
End Function
Private Sub ShowData(rs As ADODB.Recordset)
With rs
LrText(0) = Trim(.Fields("CusCode") & "") '客户编码
LrText(1) = Trim(.Fields("CusName") & "") '客户名称
LrText(2) = Trim(.Fields("Areaname") & "") '地区名称
LrText(3) = Trim(.Fields("Tradename") & "") '行业名称
LrText(4) = Trim(.Fields("Address") & "") '地址
LrText(5) = Trim(.Fields("postcode") & "") '邮政编码
LrText(6) = Trim(.Fields("taxcode") & "") '税号
LrText(7) = Trim(.Fields("fictperson") & "") '法人
LrText(8) = Trim(.Fields("bank") & "") '开户银行
LrText(9) = Trim(.Fields("bankaccount") & "") '银行账号
LrText(10) = Trim(.Fields("cussuper") & "") '上级主管部门
LrText(11) = Trim(.Fields("email") & "") 'email
LrText(12) = Trim(.Fields("worknet")) '网址
LrText(13) = Trim(.Fields("contactperson") & "") '联系人
LrText(14) = Trim(.Fields("contacttype") & "") '联系方式
LrText(15) = Trim(.Fields("desaddress") & "") '收货地址
LrText(16) = Trim(.Fields("creditgrade") & "") '信用等级
LrText(17) = Trim(.Fields("creditmoney") & "") '信用额度
LrText(18) = Trim(.Fields("creditagemoney") & "") '帐龄额度
LrText(19) = Trim(.Fields("creditdate") & "") '信用天数
'
LrText(25) = Trim(.Fields("deptname") & "") '公司分管部门名称
LrText(26) = Trim(.Fields("Personname") & "") '所属销售员
LrText(27) = Format(Trim(.Fields("relationdate") & ""), "yyyy-mm-dd") '发展日期
If .Fields("stopflag") Then '停用标志
ChkStopUse.Value = 1
Else
ChkStopUse.Value = 0
End If
str_cusname = LrText(1)
End With
End Sub
Private Sub Scdqjl() '删 除 当 前 记 录
Dim Yhanswer As Integer
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
Exit Sub
End If
'非数据行不能删除
If CzxsGrid.Row < CzxsGrid.FixedRows Then
Exit Sub
End If
'用户确认是否删除记录
Tsxx = "请确认是否删除当前记录?"
Yhanswer = Xtxxts(Tsxx, 2, 2)
If Yhanswer = 2 Then
Exit Sub
End If
On Error GoTo Cwcl
Cw_DataEnvi.DataConnect.BeginTrans
'[>>以下需自定义部分
Cw_DataEnvi.DataConnect.Execute "delete Gy_Customer where CusCode = '" + Trim(CzxsGrid.TextMatrix(CzxsGrid.Row, Sydz("001", GridStr(), Szzls))) + "'"
'以上为自定义部分<<]
Cw_DataEnvi.DataConnect.CommitTrans
CzxsGrid.RemoveItem CzxsGrid.Row
Exit Sub
Cwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
If Err.Number = -2147217873 Then '(-2147217873 为SQL Server 2000通过建立外键产生的错误号)
Tsxx = "此客户已经被使用,不⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -