📄 frmqycbkhedit.frm
字号:
End
Begin VB.Label Label39
Caption = "电子邮件"
Height = 375
Left = -74520
TabIndex = 65
Top = 3540
Width = 1695
End
Begin VB.Label Label40
Caption = "手 机"
Height = 375
Left = -70080
TabIndex = 64
Top = 2880
Width = 1695
End
Begin VB.Label Label41
Caption = "职 务"
Height = 375
Left = -74520
TabIndex = 63
Top = 2220
Width = 1695
End
Begin VB.Label Label42
Caption = "办公电话"
Height = 375
Left = -70080
TabIndex = 62
Top = 2220
Width = 1695
End
Begin VB.Label Label43
Caption = "办公传真"
Height = 375
Left = -74520
TabIndex = 61
Top = 2880
Width = 1695
End
Begin VB.Label Label44
Caption = "学 历"
Height = 375
Left = -70080
TabIndex = 60
Top = 1560
Width = 1695
End
Begin VB.Label Label45
Caption = "年 龄"
Height = 375
Left = -74520
TabIndex = 59
Top = 1560
Width = 1695
End
Begin VB.Label Label46
Caption = "性 别"
Height = 375
Left = -70080
TabIndex = 58
Top = 900
Width = 1695
End
Begin VB.Label Label47
Caption = "经 办 人"
Height = 375
Left = -74520
TabIndex = 57
Top = 900
Width = 1335
End
Begin VB.Label Label48
Caption = "备 注"
Height = 375
Left = -70080
TabIndex = 56
Top = 6000
Width = 1695
End
End
End
End
Attribute VB_Name = "frmQYCBKHEDIT"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub ADDRESS_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then SendKeys "{tab}"
End Sub
Private Sub BDHTH_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then SendKeys "{tab}"
End Sub
Private Sub BXF_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then SendKeys "{tab}"
End Sub
Private Sub BXQX_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then SendKeys "{tab}"
End Sub
Private Sub BXXQ_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then SendKeys "{tab}"
End Sub
Private Sub CGSBYJ_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then SendKeys "{tab}"
End Sub
Private Sub Command1_Click()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim strsql As String
' If BDHTH = "" Then
' Exit Sub
' Else
strsql = "select * from khjbzl where xh='" & XH & "'"
rs.Open strsql, gCnn, adOpenStatic, adLockOptimistic
If Not rs.EOF Then
If MsgBox("确定删除序号号为：" & XH & " 的企业资料？", vbYesNo, "修改询问") = vbNo Then
Exit Sub
End If
End If
rs.Delete
ClearText
Call Form_Load
' End If
End Sub
Private Sub Command2_Click()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim strsql As String
'On Error GoTo ErrHandle
strsql = "select * from khjbzl where xh='" & XH & "'"
rs.Open strsql, gCnn, adOpenStatic, adLockOptimistic
If Not rs.EOF Then
If MsgBox("确定修改序号为：" & XH & " 的企业资料？", vbYesNo, "修改询问") = vbNo Then
Exit Sub
End If
Else
rs.AddNew
End If
rs.Fields("BDHTH") = Trim(BDHTH)
rs.Fields("TBXZ") = Trim(XH)
rs.Fields("BXF") = Trim(BXF)
rs.Fields("BXQX") = Trim(BXQX)
rs.Fields("TBRQ") = Trim(TBRQ)
rs.Fields("SXRQ") = Trim(SXRQ)
rs.Fields("XBRQ") = Trim(XBRQ)
rs.Fields("XH") = Trim(XH)
rs.Fields("khdj") = KHDJ
rs.Fields("FZRXL") = FZRXL
rs.Fields("KHLX") = Trim(KHLX)
rs.Fields("XSQD") = Trim(XSQD)
rs.Fields("DWMC") = Trim(DWMC)
rs.Fields("ADDRESS") = Trim(ADDRESS)
rs.Fields("YZBM") = Trim(YZBM)
rs.Fields("HY") = Trim(HY)
rs.Fields("ZGRS") = Trim(ZGRS)
rs.Fields("XYQK") = Trim(XYQK)
rs.Fields("BXXQ") = Trim(BXXQ)
rs.Fields("HTDQQK") = Trim(HTDQQK)
rs.Fields("YJBX") = Trim(YJBX)
rs.Fields("JCQK") = Trim(JCQK)
rs.Fields("ZT") = Trim(ZT)
rs.Fields("JZDS") = Trim(JZDS)
rs.Fields("JDFX") = Trim(JDFX)
rs.Fields("CGSBYJ") = Trim(CGSBYJ)
rs.Fields("FZR") = Trim(FZR)
rs.Fields("FZRXB") = Trim(FZRXB)
rs.Fields("FZRNL") = Trim(FZRNL)
rs.Fields("FZRZW") = Trim(FZRZW)
rs.Fields("FZRBGDH") = Trim(FZRBGDH)
rs.Fields("FZRSJ") = Trim(FZRSJ)
rs.Fields("FZREMAIL") = Trim(FZREMAIL)
rs.Fields("FZRADDRESS") = Trim(FZRADDRESS)
rs.Fields("FZRJTDH") = Trim(FZRJTDH)
rs.Fields("FZRSR") = Trim(FZRSR)
rs.Fields("FZRGRAH") = Trim(FZRGRAH)
rs.Fields("FZRXG") = Trim(FZRXG)
rs.Fields("JBR") = Trim(JBR)
rs.Fields("JBRXB") = Trim(JBRXB)
rs.Fields("JBRNL") = Trim(JBRNL)
rs.Fields("JBRXL") = Trim(JBRXL)
rs.Fields("JBRZW") = Trim(JBRZW)
rs.Fields("JBRBGDH") = Trim(JBRBGDH)
rs.Fields("JBRCZ") = Trim(JBRCZ)
rs.Fields("JBRSJ") = Trim(JBRSJ)
rs.Fields("JBREMAIL") = Trim(JBREMAIL)
rs.Fields("JBRADDRESS") = Trim(JBRADDRESS)
rs.Fields("JBRJTDH") = Trim(JBRJTDH)
rs.Fields("JBRSR") = Trim(JBRSR)
rs.Fields("JBRGRAH") = Trim(JBRGRAH)
rs.Fields("JBRXG") = Trim(JBRXG)
rs.Fields("JSR") = Trim(JSR)
rs.Fields("JSRLXDH") = Trim(JSRLXDH)
rs.Fields("JSRJSTJ") = Trim(JSRJSTJ)
rs.Fields("BDHTH") = Trim(BDHTH)
rs.Fields("khlx") = 1
rs.Fields("czy") = gUser
rs.Fields("qtyd") = QTYD
rs.Fields("memo") = MEMO
rs.Update
MsgBox "保存成功!!", vbInformation, "系统提示"
Call Form_Load
Exit Sub
'ErrHandle:
' MsgBox Err.Description, "系统提示"
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Sub Command4_Click()
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim msg As String
Dim strsql As String
strsql = "select 序号,单位名称 from VIEWQY1 "
If Trim(Findbt) <> "" And Trim(findnr) <> "" Then
strsql = strsql & " where " & Findbt & " like '%" & findnr & "%' " & " And " & " 客户类型 " & "='1' and 操作员='" & gUser & "'"
Else
strsql = "select 序号,单位名称 from VIEWQY1 where 操作员='" & gUser & "'"
End If
rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
If rs.RecordCount > 0 Then
msg = ShowListView(ListView1, rs, False, "3000,4000")
End If
End Sub
Private Sub findnr_Click()
findnr = ""
End Sub
Private Sub findnr_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
KL.Tab = 0
Command4_Click
End If
End Sub
Private Sub Form_Load()
If Me.WindowState = 0 Then Me.Move 0, 0, 14670, 8325
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim i As Long
rs.Open "select * from VIEWQY1", gCnn, adOpenStatic, adLockReadOnly
Findbt.Clear
For i = 0 To rs.Fields.count - 1
Findbt.AddItem rs.Fields(i).name
Next
Dim msg As String
Dim strsql As String
strsql = "select 序号,单位名称 from VIEWQY1 where 操作员='" & gUser & "'"
If rs.State = 1 Then rs.Close
rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
If rs.RecordCount > 0 Then
msg = ShowListView(ListView1, rs, False, "3000,4000")
End If
If rs.State = 1 Then rs.Close
rs.Open "select * from PARAMETERS where paratype=1 order by valueid", gCnn, adOpenStatic, adLockPessimistic
If Not rs.EOF Then
For i = 0 To rs.RecordCount - 1
KHDJ.AddItem rs("VALUE")
rs.MoveNext
Next
End If
End Sub
Private Sub FillText(CODE1 As String, CODE2 As String)
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim strsql As String
On Error GoTo ErrHandle
strsql = "select * from VIEWQY1 "
strsql = strsql & " where " & Trim(CODE1) & " like '%" & Trim(CODE2) & "%'"
rs.Open strsql, gCnn, adOpenStatic, adLockReadOnly
If Not rs.EOF Then
BDHTH = rs("保单合同号")
TBXZ = rs("投保险种")
BXF = rs("保险费")
BXQX = rs("保险期限")
TBRQ = rs("投保日期")
SXRQ = rs("生效日期")
XBRQ = rs("续保日期")
QTYD = rs("其他约定")
XH = rs("序号")
KHDJ = rs("客户等级")
XSQD = rs("销售渠道")
DWMC = rs("单位名称")
ADDRESS = rs("地址")
YZBM = rs("邮政编码")
HY = rs("行业")
ZGRS = rs("职工人数")
XYQK = rs("效益情况")
BXXQ = rs("保险需求")
HTDQQK = rs("原合同到期情况")
YJBX = rs("预计保险")
JCQK = rs("接触情况")
ZT = rs("状态")
JZDS = rs("竞争对手")
JDFX = rs("焦点分析")
CGSBYJ = rs("成功失败原因")
FZR = rs("负责人")
FZRXB = rs("负责人性别")
FZRNL = rs("负责人年龄")
FZRXL = rs("负责人学历")
FZRZW = rs("负责人职务")
FZRBGDH = rs("负责人办公电话")
FZRSJ = rs("负责人手机")
FZREMAIL = rs("负责人电子邮件")
FZRADDRESS = rs("负责人家庭住址")
FZRJTDH = rs("负责人家庭电话")
FZRSR = rs("负责人生日")
FZRGRAH = rs("负责人个人爱好")
FZRXG = rs("负责人性格")
JBR = rs("经办人")
JBRXB = rs("经办人性别")
JBRNL = rs("经办人年龄")
JBRXL = rs("经办人学历")
JBRZW = rs("经办人职务")
JBRBGDH = rs("经办人办公电话")
JBRCZ = rs("经办人办公传真")
JBRSJ = rs("经办人手机")
JBREMAIL = rs("经办人电子邮件")
JBRADDRESS = rs("经办人家庭住址")
JBRGTDH = rs("经办人家庭电话")
JBRSR = rs("经办人生日")
JBRGRAH = rs("经办人个人爱好")
JBRXG = rs("经办人性格")
JSR = rs("介绍人")
JSRLXDH = rs("介绍人联系电话")
JSRTJ = rs("介绍条件")
MEMO = rs("备注")
End If
Exit Sub
ErrHandle:
MsgBox Err.Description, vbCritical, "系统提示"
End Sub
Private Sub ClearText()
BDHTH = ""
TBXZ = ""
BXF = ""
BXQX = ""
TBRQ = Now
SXRQ = Now
XBRQ = Now
XH = ""
KHDJ = ""
XSQD = ""
DWMC = ""
ADDRESS = ""
YZBM = ""
HY = ""
ZGRS = ""
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -