📄 frm_khxxwh_lxr.frm
字号:
Private Sub Dtp_Date_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then Txt1(3).SetFocus
End Sub
Private Sub Dtp_Date_LostFocus()
Dtp_Date.CalendarBackColor = &HFFFFFF
End Sub
Private Sub Form_Activate()
Adodc1.ConnectionString = PublicStr
Adodc2.ConnectionString = PublicStr
Call Dgr_Title
If sql <> "" Then
Adodc1.RecordSource = sql & " order by lxrxx_id"
Adodc1.Refresh
Call view_data '调用过程
Call Dgr_Title
If Adodc1.Recordset.RecordCount = 0 Then
MsgBox "没有找到符合条件的记录！", , "提示窗口"
End If
End If
End Sub
Sub Dgr_Title()
Dgr_Lxr.Columns(0).Caption = "联系人编号"
Dgr_Lxr.Columns(1).Caption = "企业名称"
Dgr_Lxr.Columns(2).Caption = "联系人姓名"
Dgr_Lxr.Columns(3).Caption = "联系人性别"
Dgr_Lxr.Columns(4).Caption = "出生年月"
Dgr_Lxr.Columns(5).Caption = "联系人年龄"
Dgr_Lxr.Columns(6).Caption = "联系人职位"
Dgr_Lxr.Columns(7).Caption = "办公电话"
Dgr_Lxr.Columns(8).Caption = "电子邮件"
Dgr_Lxr.Columns(9).Caption = "联系人手机"
Dgr_Lxr.Columns(10).Caption = "个人简介"
Dgr_Lxr.Columns(11).Caption = "登记日期"
Dgr_Lxr.Columns(12).Caption = "信息登记人"
Dgr_Lxr.Columns(13).Caption = "备注信息"
End Sub
Private Sub Form_Load()
'设置DataGrid标题
Call Dgr_Title
'设置控件状态
For i = 0 To 8
Txt1(i).Enabled = False
Next i
Cbx_Qymc.Enabled = False
Cbx_Xb.Enabled = False
Dtp_Csny.Enabled = False
Cbx_Zw.Enabled = False
Dtp_Date.Enabled = False
tlbState Toolbar1, False
'设置联系人性别信息
Cbx_Xb.AddItem ("男")
Cbx_Xb.AddItem ("女")
Cbx_Xb.Text = "请选择"
'设置联系人职位
Cbx_Zw.AddItem ("董事长")
Cbx_Zw.AddItem ("总经理")
Cbx_Zw.AddItem ("营销主管")
Cbx_Zw.AddItem ("市场主管")
Cbx_Zw.AddItem ("宣传主管")
Cbx_Zw.AddItem ("总工程师")
Cbx_Zw.AddItem ("外联主管")
Cbx_Zw.AddItem ("人力资源主管")
Cbx_Zw.AddItem ("职员")
Cbx_Zw.Text = "请选择"
Dim rs2 As New ADODB.Recordset
rs2.Open "select * from tb_khxx order by khxx_id", cnn, adOpenKeyset
If rs2.RecordCount > 0 Then
For i = 0 To rs2.RecordCount - 1
Cbx_Qymc.AddItem Trim(rs2.Fields("khxx_mc"))
rs2.MoveNext
Next i
End If
If Cbx_Qymc.ListCount = 0 Then
Cbx_Qymc.Text = "请选择"
Else
Cbx_Qymc.ListIndex = 0
End If
rs2.Close
Dtp_Date.Value = Date
tlbState Toolbar1, False
view_data
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
sql = ""
End Sub
Private Sub Form_Unload(Cancel As Integer)
Frm_Main.Enabled = True
End Sub
Private Sub Txt1_GotFocus(Index As Integer)
Txt1(Index).BackColor = &HFFFF80
Txt1(Index).SelStart = 0
Txt1(Index).SelLength = Len(Txt1(Index))
End Sub
Private Sub txt1_KeyPress(Index As Integer, KeyAscii As Integer)
If KeyAscii = 13 Then
If Index = 1 Then Cbx_Xb.SetFocus
If Index = 2 Then Cbx_Zw.SetFocus
End If
If KeyAscii = 13 And Index >= 3 Then
If Index = 8 Then Exit Sub
Txt1(Index + 1).SetFocus
End If
End Sub
Private Sub Txt1_LostFocus(Index As Integer)
Txt1(Index).BackColor = &HFFFFFF
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
Adodc1.RecordSource = "select * from tb_Client_lxrxx order by lxrxx_id"
Adodc1.Refresh
If Adodc1.Recordset.RecordCount > 0 Then
If SSTab1.Tab = 1 And Toolbar1.Buttons(1).Enabled = False Then
MsgBox "您正在处理数据,请取消数据处理,再执行本操作！", , "提示窗口"
SSTab1.Tab = 0
Else
If Toolbar1.Buttons(1).Enabled = True Then view_data
End If
End If
Call Dgr_Title
End Sub
Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
Call Dgr_Title
Dtp_Date.Enabled = False
Select Case Button.key
Case "add" '添加
blnadd1 = True
tlbState Toolbar1, True
'自动创建客户编号
Dim rs1 As New ADODB.Recordset
rs1.Open "select * from tb_Client_lxrxx order by lxrxx_id", cnn, adOpenKeyset
If rs1.RecordCount > 0 Then
If rs1.EOF = False Then rs1.MoveLast
Txt1(0).Text = "LXR" + Format(Val(Right(Trim(rs1.Fields("lxrxx_id")), 3)) + 1, "###000") '编号自动加1
Else
Txt1(0).Text = "LXR001"
End If
rs1.Close '关闭数据集对象
For i = 1 To 8
Txt1(i).Enabled = True
Txt1(i).Text = ""
Next i
Cbx_Qymc.Enabled = True
Cbx_Xb.Enabled = True
Dtp_Csny.Enabled = True
Cbx_Zw.Enabled = True
Txt1(2).Locked = True
For i = 8 To 11
Toolbar1.Buttons(i).Enabled = False
Next i
SSTab1.Tab = 0
Dtp_Date.Value = Date
Cbx_Qymc.SetFocus
Cbx_Qymc.Locked = False
Txt1(7).Text = Frm_Main.StatusBar1.Panels(2).Text
Case "modify" '修改
If Adodc1.Recordset.RecordCount > 0 Then
blnadd1 = False
view_data
For i = 1 To 8
Txt1(i).Enabled = True
Next i
tlbState Toolbar1, True
Cbx_Qymc.Enabled = True
Cbx_Xb.Enabled = True
Dtp_Csny.Enabled = True
Cbx_Zw.Enabled = True
Dtp_Date.Value = Date
Txt1(2).Locked = True
For i = 8 To 11
Toolbar1.Buttons(i).Enabled = False
Next i
Else
MsgBox "系统没有要修改的数据！", , "客户关系管理系统"
End If
Case "delete"
If Adodc1.Recordset.RecordCount > 0 Then
myval = MsgBox("您确实要删除这条数据吗？", vbYesNo, "提示窗口")
If myval = vbYes Then
Adodc1.Recordset.Delete
Unload Me
Adodc1.Refresh
Frm_Khxxwh_Lxr.Show 1
End If
Else
MsgBox "系统没有要删除的数据！", , "提示窗口"
End If
Case "save"
If Txt1(1) = "" Then
MsgBox "系统不允许联系人姓名为空！", , "提示窗口"
Exit Sub
End If
If Cbx_Qymc.Text = "" Then
MsgBox "系统不允许企业名称为空！", , "提示窗口"
Exit Sub
End If
If Cbx_Xb = "" Then
MsgBox "系统不允许联系人性别为空！", , "提示窗口"
Exit Sub
End If
If Cbx_Zw = "" Then
MsgBox "系统不允许联系人职位为空！", , "提示窗口"
Exit Sub
End If
If Txt1(3).Text = "" Then
MsgBox "系统不允许办公电话为空！", , "提示窗口"
Exit Sub
End If
If Txt1(5).Text = "" Then
MsgBox "系统不允许联系人手机为空！", , "提示窗口"
Exit Sub
End If
If Not IsNumeric(Txt1(5).Text) Then
MsgBox "输入的联系人手机号码并不存在！", , "提示窗口"
Exit Sub
End If
On Error GoTo SaveErr
If blnadd1 = False Then
Set rs1 = New ADODB.Recordset
rs1.Open "select * from tb_Client_lxrxx where lxrxx_id='" + Txt1(0) + "'order by lxrxx_id", cnn, adOpenStatic
If rs1.RecordCount > 0 Then
myval = MsgBox("您确实要修改这条数据吗？", vbYesNo)
If myval = vbYes Then
cnn.Execute ("update tb_client_lxrxx set lxrxx_qymc='" + Cbx_Qymc.Text + "',lxrxx_xm='" + Txt1(1).Text + "',lxrxx_xb='" + Cbx_Xb.Text + _
"',lxrxx_csny='" + str(Dtp_Csny.Value) + "',lxrxx_nl='" + Txt1(2) + "',lxrxx_zw='" + Cbx_Zw.Text + "',lxrxx_bgdh='" + Txt1(3).Text + _
"',lxrxx_Email='" + Txt1(4) + "',lxrxx_sj='" + Txt1(5) + "',lxrxx_grjj='" + Txt1(6) + "',lxrxx_djrq='" + str(Dtp_Date.Value) + _
"',lxrxx_xxdjr='" + Txt1(7) + "',lxrxx_bz='" + Txt1(8) + "'where lxrxx_id='" + Txt1(0) + "'")
Adodc2.RecordSource = "select * from tb_khxx where khxx_mc='" + Cbx_Qymc.Text + "'"
Adodc2.Refresh
If Adodc2.Recordset.RecordCount > 0 Then
cnn.Execute ("update tb_khxx set khxx_lxr='" + Txt1(1).Text + "',khxx_gsdh='" + Txt1(3).Text + "',khxx_lxrdh='" + Txt1(5).Text + "'where khxx_mc='" + Cbx_Qymc.Text + "'")
Adodc2.Refresh
End If
' Unload Me
' Adodc1.Refresh
' Frm_Khxxwh_Lxr.Show 1
Adodc1.Refresh
Set Dgr_Lxr.DataSource = Adodc1
Call Dgr_Title
End If
End If
rs1.Close
Else
Set rs1 = New ADODB.Recordset
rs1.Open "tb_client_lxrxx", cnn, adOpenKeyset, adLockOptimistic
'添加联系人信息
rs1.AddNew
rs1.Fields("lxrxx_id") = Txt1(0).Text
rs1.Fields("lxrxx_qymc") = Cbx_Qymc.Text
rs1.Fields("lxrxx_xm") = Txt1(1).Text
rs1.Fields("lxrxx_xb") = Cbx_Xb.Text
rs1.Fields("lxrxx_csny") = Dtp_Csny.Value
rs1.Fields("lxrxx_nl") = Txt1(2).Text
rs1.Fields("lxrxx_zw") = Cbx_Zw.Text
rs1.Fields("lxrxx_bgdh") = Txt1(3).Text
rs1.Fields("lxrxx_Email") = Txt1(4).Text
rs1.Fields("lxrxx_sj") = Txt1(5).Text
rs1.Fields("lxrxx_grjj") = Txt1(6).Text
rs1.Fields("lxrxx_djrq") = Dtp_Date.Value
rs1.Fields("lxrxx_xxdjr") = Txt1(7).Text
rs1.Fields("lxrxx_bz") = Txt1(8).Text
rs1.Update '更新数据库
Adodc2.RecordSource = "select * from tb_khxx where khxx_mc='" + Cbx_Qymc.Text + "'"
Adodc2.Refresh
If Adodc2.Recordset.RecordCount > 0 Then
cnn.Execute ("update tb_khxx set khxx_lxr='" + Txt1(1).Text + "',khxx_lxrdh='" + Txt1(5).Text + "'where khxx_mc='" + Cbx_Qymc.Text + "'")
Adodc2.Refresh
End If
rs1.Close
Adodc1.Refresh
End If
For i = 0 To 8
Txt1(i).Enabled = False
Next i
Cbx_Qymc.Enabled = False
Cbx_Xb.Enabled = False
Dtp_Csny.Enabled = False
Cbx_Zw.Enabled = False
tlbState Toolbar1, False
For i = 8 To 11
Toolbar1.Buttons(i).Enabled = True
Next i
Exit Sub
SaveErr:
MsgBox Err.Description, , "信息提示"
Case "cancel"
view_data
For i = 0 To 8
Txt1(i).Enabled = False
Next i
Cbx_Qymc.Enabled = False
Cbx_Xb.Enabled = False
Dtp_Csny.Enabled = False
Cbx_Zw.Enabled = False
tlbState Toolbar1, False
For i = 8 To 11
Toolbar1.Buttons(i).Enabled = True
Next i
Case "find"
Tb = "tb_Client_lxrxx"
Load Frm_Cx
Frm_Cx.Show 1
Case "first" '移到第一条记录
If Adodc1.Recordset.BOF = False Then Adodc1.Recordset.MoveFirst
Call view_data '调用过程
Call Dgr_Title
Case "previous" '移到上一条记录
If Adodc1.Recordset.RecordCount > 0 Then
If Adodc1.Recordset.BOF = False Then Adodc1.Recordset.MovePrevious
If Adodc1.Recordset.BOF = True Then Adodc1.Recordset.MoveFirst
End If
Call view_data '调用过程
Call Dgr_Title
Case "next" '移到下一条记录
If Adodc1.Recordset.RecordCount > 0 Then
If Adodc1.Recordset.EOF = False Then Adodc1.Recordset.MoveNext
If Adodc1.Recordset.EOF = True Then Adodc1.Recordset.MoveLast
End If
Call view_data '调用过程
Call Dgr_Title
Case "last" '移到最后一条记录
If Adodc1.Recordset.EOF = False Then Adodc1.Recordset.MoveLast
Call view_data '调用过程
Call Dgr_Title
Case "close"
Unload Me
End Select
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -