?? frm_khxxwh_kh.frm
字號:
Dgr_Kh.Columns(15).Caption = "公司電話"
Dgr_Kh.Columns(16).Caption = "公司傳真"
Dgr_Kh.Columns(17).Caption = "主要聯系人"
Dgr_Kh.Columns(18).Caption = "聯系人電話"
Dgr_Kh.Columns(19).Caption = "客戶級別"
Dgr_Kh.Columns(20).Caption = "備注信息"
End Sub
Private Sub Form_Load()
On Error Resume Next
'設置DataGrid標題
Call Dgr_Title
'設置控件狀態
For i = 0 To 14
Txt1(i).Enabled = False
Next i
Cbx_Xz.Enabled = False
Cbx_Jb.Enabled = False
Cbx_Lx.Enabled = False
Cbx_Zx.Enabled = False
Cbx_Sf.Enabled = False
Cbx_Cs.Enabled = False
tlbState Toolbar1, False
Dim rs2 As New ADODB.Recordset
rs2.Open "select * from tb_Client_qyxz", cnn, adOpenKeyset
If rs2.RecordCount > 0 Then
For i = 0 To rs2.RecordCount - 1
Cbx_Xz.AddItem Trim(rs2.Fields("qyxz_xzmc"))
rs2.MoveNext
Next i
End If
If Cbx_Xz.ListCount = 0 Then
Cbx_Xz.Text = "請選擇"
Else
Cbx_Xz.ListIndex = 0
End If
rs2.Close
Dim rs3 As New ADODB.Recordset
rs3.Open "select * from tb_Client_khjb", cnn, adOpenKeyset
If rs3.RecordCount > 0 Then
For i = 0 To rs3.RecordCount - 1
Cbx_Jb.AddItem rs3.Fields("khjb_jbmc")
rs3.MoveNext
Next i
End If
If Cbx_Jb.ListCount = 0 Then
Cbx_Jb.Text = "請選擇"
Else
Cbx_Jb.ListIndex = 0
End If
rs3.Close
Dim rs4 As New ADODB.Recordset
rs4.Open "select * from tb_Client_qylx", cnn, adOpenKeyset
If rs4.RecordCount > 0 Then
For i = 0 To rs4.RecordCount - 1
Cbx_Lx.AddItem rs4.Fields("qylx_lxmc")
rs4.MoveNext
Next i
End If
If Cbx_Lx.ListCount = 0 Then
Cbx_Lx.Text = "請選擇"
Else
Cbx_Lx.ListIndex = 0
End If
rs4.Close
Dim rs5 As New ADODB.Recordset
rs5.Open "select * from tb_Client_qyzx", cnn, adOpenKeyset
If rs5.RecordCount > 0 Then
For i = 0 To rs5.RecordCount - 1
Cbx_Zx.AddItem rs5.Fields("qyzx_zxjb")
rs5.MoveNext
Next i
End If
If Cbx_Zx.ListCount = 0 Then
Cbx_Zx.Text = "請選擇"
Else
Cbx_Zx.ListIndex = 0
End If
rs5.Close
Dim rs6 As New ADODB.Recordset
rs6.Open "select * from tb_Client_sfzy", cnn, adOpenKeyset
If rs6.RecordCount > 0 Then
For i = 0 To rs6.RecordCount - 1
Cbx_Sf.AddItem rs6.Fields("sfzy_sfmc")
rs6.MoveNext
Next i
End If
If Cbx_Sf.ListCount = 0 Then
Cbx_Sf.Text = "請選擇"
Else
Cbx_Sf.ListIndex = 0
End If
rs6.Close
Cbx_Cs.Text = ""
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_Xz.SetFocus
If Index = 2 Then Cbx_Sf.SetFocus
End If
If KeyAscii = 13 And Index >= 3 Then
If Index = 14 Then Exit Sub
Txt1(Index + 1).SetFocus
End If
If KeyAscii = vbKeyUp And Index > 1 Then Txt1(Index - 1).SetFocus
End Sub
Private Sub Txt1_LostFocus(Index As Integer)
Txt1(Index).BackColor = &HFFFFFF
If Index = 3 Then
If Not IsNumeric(Txt1(3).Text) Then
MsgBox "請輸入正確的郵編信息!", , "信息提示"
Cbx_Sf.SetFocus
Exit Sub
End If
If Len(Txt1(3).Text) <> 6 Then
MsgBox "請輸入正確的郵編信息", , "信息提示"
Cbx_Sf.SetFocus
Exit Sub
End If
Myrs.Open "select * from tb_Client_csxx where csxx_sfmc='" + Cbx_Sf.Text + "' and csxx_csmc='" + Cbx_Cs.Text + "' and csxx_yb like '" + Txt1(3).Text + "'+'%'", cnn, adOpenKeyset
If Myrs.RecordCount <= 0 Then
MsgBox "請輸入正確的郵編信息!", , "信息提示"
Cbx_Sf.SetFocus
Myrs.Close
Exit Sub
End If
Myrs.Close
End If
If Index = 10 Then
If Left(Txt1(10).Text, Len(Mystr)) <> Mystr Then
MsgBox "請輸入正確的公司電話信息!", , "信息提示"
Txt1(10).Text = Mystr
Txt1(10).SetFocus
Exit Sub
End If
If Not IsNumeric(Right(Txt1(10).Text, (Len(Txt1(10).Text) - Len(Mystr)))) Then
MsgBox "請輸入正確的公司電話信息!", , "信息提示"
Txt1(10).Text = Mystr
Txt1(10).SetFocus
Exit Sub
End If
End If
End Sub
Private Sub SSTab1_Click(PreviousTab As Integer)
Adodc1.RecordSource = "select * from tb_khxx order by khxx_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)
Select Case Button.key
Case "add" '添加
blnadd1 = True
tlbState Toolbar1, True
'自動創建客戶編號
Dim rs1 As New ADODB.Recordset
rs1.Open "select * from tb_khxx order by khxx_id", cnn, adOpenKeyset
If rs1.RecordCount > 0 Then
If rs1.EOF = False Then rs1.MoveLast
Txt1(0).Text = "KH" + Format(Val(Right(Trim(rs1.Fields("khxx_id")), 3)) + 1, "###000") '編號自動加1
Else
Txt1(0).Text = "KH001"
End If
rs1.Close '關閉數據集對象
For i = 1 To 14
Txt1(i).Enabled = True
Txt1(i).Text = ""
Next i
Cbx_Xz.Enabled = True
Cbx_Jb.Enabled = True
Cbx_Lx.Enabled = True
Cbx_Zx.Enabled = True
Cbx_Sf.Enabled = True
Cbx_Cs.Enabled = True
For i = 8 To 11
Toolbar1.Buttons(i).Enabled = False
Next i
SSTab1.Tab = 0
Txt1(1).SetFocus
Case "modify" '修改
If Adodc1.Recordset.RecordCount > 0 Then
blnadd1 = False
view_data
For i = 1 To 14
Txt1(i).Enabled = True
Next i
tlbState Toolbar1, True
Cbx_Xz.Enabled = True
Cbx_Jb.Enabled = True
Cbx_Lx.Enabled = True
Cbx_Zx.Enabled = True
Cbx_Sf.Enabled = True
Cbx_Cs.Enabled = True
For i = 8 To 11
Toolbar1.Buttons(i).Enabled = False
Next i
Else
MsgBox "系統沒有要修改的數據!", , "客戶關系管理系統"
End If
Case "delete" '刪除
On Error Resume Next
Dim rs8 As New ADODB.Recordset
rs8.Open "select * from tb_Client_khfk where khfk_khmc='" + Txt1(1).Text + "'", cnn, adOpenKeyset
If rs8.RecordCount > 0 Then
MsgBox "該信息正在使用不能刪除!", , "提示窗口"
Exit Sub
Else
Dim rs9 As New ADODB.Recordset
rs9.Open "select * from tb_Client_khts where khts_qymc ='" + Txt1(1).Text + "'", cnn, adOpenKeyset
If rs9.RecordCount > 0 Then
MsgBox "該信息正在使用不能刪除!", , "提示窗口"
Exit Sub
Else
If Adodc1.Recordset.RecordCount > 0 Then
myval = MsgBox("您確實要刪除這條數據嗎?", vbYesNo, "提示窗口")
If myval = vbYes Then
Adodc1.Recordset.Delete
Adodc2.RecordSource = "select * from tb_Client_lxrxx where lxrxx_qymc='" + Txt1(1).Text + "'"
Adodc2.Refresh
If Adodc2.Recordset.RecordCount > 0 Then
Adodc2.Recordset.Delete
Adodc2.Refresh
End If
Adodc1.Recordset.MoveFirst
Adodc1.Refresh
Call view_data
Set Dgr_Kh.DataSource = Adodc1
Call Dgr_Title
End If
Else
MsgBox "系統沒有要刪除的數據!", , "提示窗口"
End If
End If
rs9.Close
End If
rs8.Close
Case "save" '保存
If Txt1(1) = "" Then
MsgBox "系統不允許客戶名稱為空!", , "提示窗口"
Exit Sub
End If
If Txt1(2) = "" Then
MsgBox "系統不允許客戶地址為空!", , "提示窗口"
Exit Sub
End If
If Cbx_Xz = "" Then
MsgBox "系統不允許客戶性質為空!", , "提示窗口"
Exit Sub
End If
If Cbx_Jb = "" Then
MsgBox "系統不允許客戶級別為空!", , "提示窗口"
Exit Sub
End If
If Cbx_Lx = "" Then
MsgBox "系統不允許客戶類型為空!", , "提示窗口"
Exit Sub
End If
If Cbx_Zx = "" Then
MsgBox "系統不允許客戶資信為空!", , "提示窗口"
Exit Sub
End If
If Txt1(6).Text = "" Then
MsgBox "系統不允許銀行帳號為空!", , "提示窗口"
Exit Sub
End If
If Txt1(13).Text = "" Then
MsgBox "系統不允許聯系人電話為空!", , "提示窗口"
Exit Sub
End If
If Not IsNumeric(Txt1(13).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_khxx where khxx_id='" + Txt1(0) + "'order by khxx_id", cnn, adOpenStatic
If rs1.RecordCount > 0 Then
myval = MsgBox("您確實要修改這條數據嗎?", vbYesNo)
If myval = vbYes Then
cnn.Execute ("update tb_khxx set khxx_mc='" + Txt1(1) + "',khxx_qyxz='" + Cbx_Xz + "',khxx_qylx='" + Cbx_Lx + _
"',khxx_qyzx='" + Cbx_Zx.Text + "',khxx_qydz='" + Txt1(2) + "',khxx_szsf='" + Cbx_Sf + "',khxx_szcs='" + Cbx_Cs + _
"',khxx_gsyb='" + Txt1(3) + "',khxx_frdb='" + Txt1(4) + "',khxx_khyh='" + Txt1(5) + "',khxx_yhzh='" + Txt1(6) + _
"',khxx_nsh='" + Txt1(7) + "',khxx_ICcard='" + Txt1(8) + "',khxx_gswz='" + Txt1(9) + "',khxx_gsdh='" + Txt1(10) + "',khxx_gscz='" + Txt1(11) + "',khxx_lxr='" + Txt1(12) + "',khxx_khjb='" + Cbx_Jb.Text + "',khxx_lxrdh='" + Txt1(13) + "',khxx_bz='" + Txt1(14) + "' where khxx_id='" + Txt1(0) + "'")
Unload Me
Adodc1.Refresh
Frm_Khxxwh_kh.Show 1
End If
End If
rs1.Close
Else
Set rs1 = New ADODB.Recordset
rs1.Open "tb_khxx", cnn, adOpenKeyset, adLockOptimistic
'添加客戶信息
rs1.AddNew
rs1.Fields("khxx_id") = Txt1(0).Text
rs1.Fields("khxx_mc") = Txt1(1).Text
rs1.Fields("khxx_qyxz") = Cbx_Xz.Text
rs1.Fields("khxx_qylx") = Cbx_Lx.Text
rs1.Fields("khxx_qyzx") = Cbx_Zx.Text
rs1.Fields("khxx_qydz") = Txt1(2).Text
rs1.Fields("khxx_szsf") = Cbx_Sf.Text
rs1.Fields("khxx_szcs") = Cbx_Cs.Text
rs1.Fields("khxx_gsyb") = Txt1(3).Text
rs1.Fields("khxx_frdb") = Txt1(4).Text
rs1.Fields("khxx_khyh") = Txt1(5).Text
rs1.Fields("khxx_yhzh") = Txt1(6).Text
rs1.Fields("khxx_nsh") = Txt1(7).Text
rs1.Fields("khxx_ICcard") = Txt1(8).Text
rs1.Fields("khxx_gswz") = Txt1(9).Text
rs1.Fields("khxx_gsdh") = Txt1(10).Text
rs1.Fields("khxx_gscz") = Txt1(11).Text
rs1.Fields("khxx_lxr") = Txt1(12).Text
rs1.Fields("khxx_lxrdh") = Txt1(13).Text
rs1.Fields("khxx_bz") = Txt1(14).Text
rs1.Fields("khxx_khjb") = Cbx_Jb.Text
rs1.Update '更新數據庫
Adodc1.Refresh
rs1.Close
End If
For i = 0 To 14
Txt1(i).Enabled = False
Next i
Cbx_Xz.Enabled = False
Cbx_Jb.Enabled = False
Cbx_Lx.Enabled = False
Cbx_Zx.Enabled = False
Cbx_Sf.Enabled = False
Cbx_Cs.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 14
Txt1(i).Enabled = False
Next i
Cbx_Xz.Enabled = False
Cbx_Jb.Enabled = False
Cbx_Lx.Enabled = False
Cbx_Zx.Enabled = False
Cbx_Sf.Enabled = False
Cbx_Cs.Enabled = False
tlbState Toolbar1, False
For i = 8 To 11
Toolbar1.Buttons(i).Enabled = True
Next i
Case "find"
Tb = "tb_khxx"
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 + -