frm_area_customer_edit.frm

一个公司的客户财产管理系统vb源码

       Me.Txt_Fields_Dustproof.text = Trim(Me.Txt_Fields_Dustproof.text)
       If Len(Me.txt_Fields(0).text) <> 2 Then
         MsgBox "地区代码只能为2位!" + Chr(13) + "请重新输入!", vbOKOnly + vbCritical, "提示信息"
         Exit Sub
       End If
       '如果修改了地区代码
       If Str_AreaCode <> Me.txt_Fields(0).text Then
         Set Cn = New ADODB.Connection
         Cn.Open Cs
         Set Rs = New ADODB.Recordset
         Rs.Open "select * from Area_Customer where 地区编码 = '" & Me.txt_Fields(0).text & "'", Cn, adOpenKeyset, adLockOptimistic, adCmdText
         If Rs.RecordCount = 0 Then
           If Me.txt_Fields(0).text <> "" And Me.txt_Fields(1).text <> "" Then
              Rs.Close
              Rs.Open "select * from Area_Customer where 地区编码 = '" & Str_AreaCode & "'", Cn, adOpenKeyset, adLockOptimistic, adCmdText
              Rs.MoveFirst
              Do While Rs.EOF = False
                Rs!地区编码 = Me.txt_Fields(0).text
                Rs!地区名称 = Me.txt_Fields(1).text
                Rs!客户编码 = Me.txt_Fields(0).text & Right(Rs!客户编码, Len(Rs!客户编码) - 2)
                Rs.MoveNext
              Loop
              Rs.Close
              Cn.Close
              '**********************没有把客户财产表中记录也要改过来
              Set Cn = New ADODB.Connection
              Cn.Open Cs
              Set Rs = New ADODB.Recordset
              Rs.Open "select * from Customer_Riches where 内编码 like '%'+ '" & Str_AreaCode & "'+'%'", Cn, adOpenKeyset, adLockOptimistic, adCmdText
              If Rs.RecordCount <> 0 Then
                Rs.MoveFirst
                Do While Rs.EOF = False
                  Rs!内编码 = Me.txt_Fields(0).text & Right(Rs!内编码, Len(Rs!内编码) - 2)
                  Rs.MoveNext
                Loop
              End If
              Rs.Close
              Cn.Close
'              MsgBox "数据保存成功!", vbInformation, "提示"
              For i = 0 To 3
                Me.txt_Fields(i).text = ""
              Next i
              Frm_Customer_Richers.Tvw_Customer.Nodes.Clear
              Call Frm_Customer_Richers.Tree_Change
              Unload Me
           Else
             MsgBox "填写信息不完整，请检查。", vbCritical, "提示信息"
             Exit Sub
           End If
         Else
           MsgBox "此地区代码已重复!" + Chr(13) + "请重新输入!", vbCritical, "提示信息"
           Exit Sub
         End If
       Else
       '如果没有修改地区代码
         Set Cn = New ADODB.Connection
         Cn.Open Cs
         Set Rs = New ADODB.Recordset
         Rs.Open "select * from Area_Customer where 地区编码 = '" & Me.txt_Fields(0).text & "'", Cn, adOpenKeyset, adLockOptimistic, adCmdText
         If Me.txt_Fields(1).text <> "" Then
           Rs.Close
           Rs.Open "select * from Area_Customer where 地区编码 = '" & Str_AreaCode & "'", Cn, adOpenKeyset, adLockOptimistic, adCmdText
           Rs.MoveFirst
           Do While Rs.EOF = False
'             RS!地区编码 = Me.Txt_Fields(0).text
             Rs!地区名称 = Me.txt_Fields(1).text
             Rs!客户编码 = Me.txt_Fields(0).text & Right(Rs!客户编码, Len(Rs!客户编码) - 2)
             Rs.MoveNext
           Loop
           Rs.Close
           Cn.Close
'           MsgBox "数据保存成功!", vbInformation, "提示"
           For i = 0 To 3
              Me.txt_Fields(i).text = ""
           Next i
           Frm_Customer_Richers.Tvw_Customer.Nodes.Clear
           Call Frm_Customer_Richers.Tree_Change
           Unload Me
         Else
           MsgBox "填写信息不完整，请检查。", vbCritical, "提示信息"
           Exit Sub
         End If
       End If
       
    '修改客户
    Else
      If Len(AreaCustomer_Key) = 5 Then
         Me.txt_Fields(0).text = Trim(Me.txt_Fields(0).text)
         Me.txt_Fields(1).text = Trim(Me.txt_Fields(1).text)
         Me.txt_Fields(2).text = Trim(Me.txt_Fields(2).text)
         Me.txt_Fields(3).text = Trim(Me.txt_Fields(3).text)
         Me.Txt_Fields_Dustproof.text = Trim(Me.Txt_Fields_Dustproof.text)
         If Len(Me.txt_Fields(2).text) <> 5 Then
           MsgBox "客户代码只能为5位!" + Chr(13) + "请重新输入!", vbOKOnly + vbCritical, "提示信息"
           Exit Sub
         End If
         If Left(Me.txt_Fields(2).text, 2) <> Me.txt_Fields(0).text Then
           MsgBox "客户代码的前2位与地区代码不相同!" + Chr(13) + "请重新输入!", vbOKOnly + vbCritical, "提示信息"
           Exit Sub
         End If
         '如果修改了客户代码
         If Str_CustomerCode <> Me.txt_Fields(2).text Then
            Set Cn = New ADODB.Connection
            Cn.Open Cs
            Set Rs = New ADODB.Recordset
             Rs.Open "select * from Area_Customer where 客户编码 = '" & Me.txt_Fields(2).text & "'", Cn, adOpenKeyset, adLockOptimistic, adCmdText
             If Rs.RecordCount = 0 Then
               If Me.txt_Fields(2).text <> "" And Me.txt_Fields(3).text <> "" Then
                 Rs.Close
                 Rs.Open "select * from Area_Customer where 客户编码 = '" & Str_CustomerCode & "'", Cn, adOpenKeyset, adLockOptimistic, adCmdText
                 Rs.MoveFirst
                 Do While Rs.EOF = False
                   Rs!客户编码 = Me.txt_Fields(2).text
                   Rs!客户名称 = Me.txt_Fields(3).text
                   Rs.MoveNext
                 Loop
                 Rs.Close
                 Cn.Close
           '**********************没有把客户财产表中记录也要改过来
              Set Cn = New ADODB.Connection
              Cn.Open Cs
              Set Rs = New ADODB.Recordset
              Rs.Open "select * from Customer_Riches where 内编码 like '%'+ '" & Str_CustomerCode & "'+'%'", Cn, adOpenKeyset, adLockOptimistic, adCmdText
              If Rs.RecordCount <> 0 Then
                Rs.MoveFirst
                Do While Rs.EOF = False
                  Rs!内编码 = Me.txt_Fields(2).text & Right(Rs!内编码, Len(Rs!内编码) - 5)
                  Rs.MoveNext
                Loop
              End If
              Rs.Close
              Cn.Close
                
'                 MsgBox "数据保存成功!", vbInformation, "提示"
                 For i = 0 To 3
                   Me.txt_Fields(i).text = ""
                 Next i
                 Me.Txt_Fields_Dustproof.text = ""
                 Frm_Customer_Richers.Tvw_Customer.Nodes.Clear
                 Call Frm_Customer_Richers.Tree_Change
                 Unload Me
               Else
                 MsgBox "填写信息不完整，请检查。", vbCritical, "提示信息"
                 Exit Sub
               End If
             Else
               MsgBox "此客户代码已重复!" + Chr(13) + "请重新输入!", vbCritical, "提示信息"
               Exit Sub
             End If
         Else
          '没有修改过客户代码
            Set Cn = New ADODB.Connection
            Cn.Open Cs
            Set Rs = New ADODB.Recordset
            Rs.Open "select * from Area_Customer where 客户编码 = '" & Me.txt_Fields(2).text & "'", Cn, adOpenKeyset, adLockOptimistic, adCmdText
            Rs.MoveFirst
            If Me.txt_Fields(3).text <> "" Then
              Do While Rs.EOF = False
'               RS!客户编码 = Me.Txt_Fields(2).text
                Rs!客户名称 = Me.txt_Fields(3).text
                Rs!防尘垫要求 = Val(Me.Txt_Fields_Dustproof.text)
                Rs.MoveNext
              Loop
              Rs.Close
              Cn.Close
             '**********************没有把客户财产表中记录也要改过来
                
'              MsgBox "数据保存成功!", vbInformation, "提示"
              For i = 0 To 3
                Me.txt_Fields(i).text = ""
              Next i
              Me.Txt_Fields_Dustproof.text = ""
              Frm_Customer_Riches.Tvw_Customer.Nodes.Clear
              Call Frm_Customer_Riches.Tree_Change
              Unload Me
            Else
               MsgBox "填写信息不完整，请检查。", vbCritical, "提示信息"
               Exit Sub
            End If
          End If
      End If
   End If
 End If
 
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub Form_Activate()
On Error GoTo err
  
  '添加
  If YN_Area_Customer_Add = True And YN_Area_Customer_Rename = False Then
    '添加客户
    If Len(AreaCustomer_Key) = 5 Then
      Set Cn = New ADODB.Connection
      Cn.Open Cs
      Set Rs = New ADODB.Recordset
      Rs.Open "select * from Area_Customer where 地区编码 = '" & Left(AreaCustomer_Key, 2) & "' order by 客户编码", Cn, adOpenKeyset, adLockOptimistic, adCmdText
      If Rs.RecordCount > 0 Then '对地区代码/地区名/客户代码/赋值
        Rs.MoveLast
        Me.txt_Fields(0).text = Rs!地区编码
        Me.txt_Fields(1).text = Rs!地区名称
        Me.txt_Fields(2).text = Rs!地区编码 & Format(Val(Right(Rs!客户编码, 3)) + 1, "000")
        
        Me.txt_Fields(0).Enabled = False
        Me.txt_Fields(1).Enabled = False
        txt_Fields(3).text = ""
        Me.Txt_Fields_Dustproof.text = ""
        txt_Fields(3).SetFocus
      End If
      Rs.Close
      Cn.Close
   Else
     Exit Sub
   End If
 End If
 
 '修改
 If YN_Area_Customer_Add = False And YN_Area_Customer_Rename = True Then
   '修改地区
   If Len(AreaCustomer_Key) = 2 Then
     Set Cn = New ADODB.Connection
     Cn.Open Cs
     Set Rs = New ADODB.Recordset
     Rs.Open "select * from Area_Customer where 地区编码 = '" & Left(AreaCustomer_Key, 2) & "' order by 客户编码", Cn, adOpenKeyset, adLockOptimistic, adCmdText
     If Rs.RecordCount > 0 Then '对地区代码/地区名/客户代码/赋值
       Rs.MoveLast
       Me.txt_Fields(0).text = Rs!地区编码
       Me.txt_Fields(1).text = Rs!地区名称
       Str_AreaCode = Rs!地区编码
       Str_AreaName = Rs!地区名称
       Me.txt_Fields(0).Enabled = False
       Me.txt_Fields(1).Enabled = False
       Me.txt_Fields(2).Enabled = False
       Me.txt_Fields(3).Enabled = False
       Me.Txt_Fields_Dustproof.Enabled = False
     End If
     Rs.Close
     Cn.Close
   
   Else              '修改客户
      If Len(AreaCustomer_Key) = 5 Then
        Set Cn = New ADODB.Connection
        Cn.Open Cs
        Set Rs = New ADODB.Recordset
        Rs.Open "select * from Area_Customer where 客户编码 = '" & AreaCustomer_Key & "' order by 客户编码", Cn, adOpenKeyset, adLockOptimistic, adCmdText
        If Rs.RecordCount > 0 Then '对地区代码/地区名/客户代码/赋值
          Rs.MoveLast
          Me.txt_Fields(0).text = Rs!地区编码
          Me.txt_Fields(1).text = Rs!地区名称
          Me.txt_Fields(2).text = Rs!客户编码
          Me.txt_Fields(3).text = Rs!客户名称
          If IsNull(Rs!防尘垫要求) = False Then Me.Txt_Fields_Dustproof.text = Rs!防尘垫要求 Else Me.Txt_Fields_Dustproof.text = ""
          
          Me.txt_Fields(0).Enabled = False
          Me.txt_Fields(1).Enabled = False
          Me.txt_Fields(2).Enabled = False
          Str_AreaCode = Rs!地区编码
          Str_AreaName = Rs!地区名称
          Str_CustomerCode = Rs!客户编码
          Str_CustomerName = Rs!客户名称
          
        End If
        Rs.Close
        Cn.Close
      Else
'       MsgBox "你的数据录入有错误!"
       Exit Sub
      End If
    End If

 End If

Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub Form_Load()
On Error GoTo err

    For i = 0 To 3
       Me.txt_Fields(i).text = ""
    Next i
    Me.Txt_Fields_Dustproof.text = ""
Exit Sub
err:
   MsgBox err.Description, vbCritical
    
End Sub

Private Sub Txt_Fields_Change(Index As Integer)
On Error GoTo err
Select Case Index
         Case 0
            Me.txt_Fields(Index).text = UCase(Me.txt_Fields(Index).text)
            SendKeys "{end}"
         Case 2
            Me.txt_Fields(Index).text = UCase(Me.txt_Fields(Index).text)
            SendKeys "{end}"
    End Select
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub Txt_Fields_KeyPress(Index As Integer, KeyAscii As Integer)
On Error GoTo err

  Call ENTER(KeyAscii)
  
Exit Sub
err:
   MsgBox err.Description, vbCritical
  
End Sub