frm_khxxwh_kh.frm

本系统为客户管理系统 (1)本系统的数据库为SQL Server 2000

  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