⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 frm_customer_riches.frm

📁 一个公司的客户财产管理系统vb源码
💻 FRM
📖 第 1 页 / 共 5 页
字号:
🔍
12345 
            End If
          End If
          Rs_Area.MoveNext
    Loop
    
  Else
     MsgBox "记录为空!"
  End If
  Rs_Area.Close
  Cn_Area.Close
  
Exit Sub
err:
  MsgBox err.Description, vbCritical
End Sub
Private Sub Excel_Enter()
On Error GoTo xxx
    CommonDialog1.DialogTitle = "请选择你要打开的EXCEL表格"
    CommonDialog1.Filter = "EXCEL表格文件 (*.xls)|*.xls"
    CommonDialog1.InitDir = "D:\EXCEL\客户财产\"
    CommonDialog1.ShowOpen
    FileName1 = CommonDialog1.FileName
    If FileName1 <> "" Then
        Length1 = Len(FileName1)
        FileName2 = Left(FileName1, Length1 - 3) + "bz"
'        If filename1 <> "" Then
        If Dir(FileName2) = "" Then                          '判断EXCEL是否打开
          Set xlApp = CreateObject("Excel.Application")      '创建EXCEL应用类
          xlApp.Visible = True                               '设置EXCEL可见
          Set xlBook = xlApp.Workbooks.Open(FileName1)       '("D:\temp\bb.xls") '打开EXCEL工作簿
          Set xlsheet = xlBook.Worksheets("客户财产")                 '打开EXCEL工作表
          xlsheet.Activate                                   '激活工作表
     
'          cmdenter.Enabled = True
         
        Else
          MsgBox "Microsoft Excel 已经打开了关闭!" + Chr(13) + "请先关闭将所有EXCEL!"
        End If
    Else
      MsgBox "操作被取消!", vbOKOnly + vbInformation, "提示信息"
    End If
xxx:
   Exit Sub
'    Shell
   'CommonDialog1.ShowOpen


End Sub

Private Sub Form_Activate()
  Call DGrid_Width_Set(Frm_Customer_Riches)
End Sub

Private Sub Form_Load()
On Error GoTo err

  Me.tdbg_Commission.RowDividerColor = RGB(148, 190, 231)
  Me.StatusBar1.Panels(3).text = ("操作员： " + OperatorName)
  Call Tree_Change
  Set Cn_CR = New ADODB.Connection
  Cn_CR.Open Cs
  Set Rs_CR = New ADODB.Recordset
  Rs_CR.Open "select * from Customer_Riches order by 节目名称,母盘号码", Cn_CR, adOpenKeyset, adLockOptimistic, adCmdText 'adOpenKeyset, adLockOptimistic, adCmdText
  Set TDBGrid_CusRiches.DataSource = Rs_CR
  
  Call DGrid_Width_Set(Frm_Customer_Riches)
  
  Me.StatusBar1.Panels(7).text = "记录总数： " & Str(Rs_CR.RecordCount)

  
  If OperatorDepartment = "品质部-IQC" Then
    Me.Toolbar1.Buttons(2).Enabled = False
    Me.Toolbar1.Buttons(3).Enabled = False
    Me.Toolbar1.Buttons(4).Enabled = False
    If OperatorLevel <= 4 Then Me.Toolbar1.Buttons(8).Enabled = True
  ElseIf OperatorDepartment = "生产部-统计" Then
    Me.Toolbar1.Buttons(2).Enabled = False
    Me.Toolbar1.Buttons(3).Enabled = False
    Me.Toolbar1.Buttons(4).Enabled = False
    If OperatorLevel <= 4 Then Me.Toolbar1.Buttons(8).Enabled = True
  ElseIf OperatorDepartment = "营销部" Then
    Me.Toolbar1.Buttons(2).Enabled = True
    Me.Toolbar1.Buttons(3).Enabled = True
    Me.Toolbar1.Buttons(4).Enabled = True
    If OperatorLevel <= 4 Then
      Me.Toolbar1.Buttons(3).Enabled = True
      Me.Toolbar1.Buttons(8).Enabled = True
    End If
  End If

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

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo err

    Set Me.TDBGrid_CusRiches.DataSource = Nothing
    Rs_CR.Close
    Cn_CR.Close
    
    '将变量置位
    YN_Area_Customer_Add = False
    YN_Area_Customer_Rename = False
    YN_Customer_Riches_Add = False
    YN_Customer_Riches_Repair = False
    YN_Customer_Riches_View = False

    AreaCustomer_Key = ""
    AreaCustomer_Text = ""
    Str_AreaCode = ""
    Str_AreaName = ""
    Str_CustomerCode = ""
    Str_CustomerName = ""
    StrCondition = ""
    StrField = ""
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub Mnu_Add_Click()
On Error GoTo err:
    YN_Area_Customer_Add = True
    YN_Area_Customer_Rename = False
    Load Frm_Area_Customer_Edit
    Frm_Area_Customer_Edit.Show vbModal
    
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub

Private Sub Mnu_Del_Click()
On Error GoTo err
    '如果删除了地区
    If Len(AreaCustomer_Key) = 2 Then
      If MsgBox("此操作将会同时删除此地区的所有客户和其所有财产(节目源)!" + Chr(13) + "你确定要删除此地区吗?", vbYesNo + vbQuestion, "提示信息") = vbYes Then
        '将客户财产表删除
        Set Cn = New ADODB.Connection
        Cn.Open Cs
        Set Rs = New ADODB.Recordset
        Rs.Open "select * from Customer_Riches where 内编码 like '%'+ '" & Left(AreaCustomer_Key, 2) & "'+'%' order by 内编码", Cn, adOpenKeyset, adLockOptimistic, adCmdText
        If Rs.RecordCount > 0 Then '对地区代码/地区名/客户代码/赋值
          Rs.MoveFirst
          Do While Rs.EOF = False
            Rs.Delete
            Rs.Update
            Rs.MoveNext
          Loop
        End If
        Rs.Close
        Cn.Close
        
        '将此删除地区添加到删除表中
        Set Cn = New ADODB.Connection
        Cn.Open Cs
        Set Rs = New ADODB.Recordset
        Rs.Open "select * from Area_Customer_Delete", Cn, adOpenKeyset, adLockOptimistic, adCmdText
        If Rs.RecordCount <> 0 Then
          Rs.MoveLast
          Rs.AddNew
          Rs.Fields("删除时间") = Now
          Rs.Fields("删除操作员") = OperatorName
          Rs.Fields("地区编码") = AreaCustomer_Key
          Rs.Fields("地区名称") = AreaCustomer_Text
          Rs.Update
        Else
          Rs.AddNew
          Rs.Fields("删除时间") = Now
          Rs.Fields("删除操作员") = OperatorName
          Rs.Fields("地区编码") = AreaCustomer_Key
          Rs.Fields("地区名称") = AreaCustomer_Text
          Rs.Update
        End If
        Rs.Close
        Cn.Close
        
        '将地区客户表删除
        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.MoveFirst
          Do While Rs.EOF = False
            Rs.Delete
            Rs.MoveNext
          Loop
        End If
        Rs.Close
        Cn.Close
        Me.Tvw_Customer.Nodes.Clear
        Call Tree_Change
'        MsgBox "地区删除成功!"
      End If
      
    End If
    
    '如果删除了客户
    If Len(AreaCustomer_Key) = 5 Then
      If MsgBox("此操作将会同时删除此客户的所有财产(节目源)!" + Chr(13) + "你确定要删除此客户吗?", vbYesNo + vbQuestion, "提示信息") = vbYes Then
        
        '将此删除客户添加到删除表中
        Set Cn = New ADODB.Connection
        Cn.Open Cs
        Set Rs = New ADODB.Recordset
        Rs.Open "select * from Area_Customer where 客户编码 like '%'+ '" & Left(AreaCustomer_Key, 5) & "'+'%' order by 客户编码", Cn, adOpenKeyset, adLockOptimistic, adCmdText
        If Rs.RecordCount > 0 Then '对地区代码/地区名/客户代码/赋值
          Rs.MoveFirst
          Set Cn_Common = New ADODB.Connection
          Cn_Common.Open Cs
          Set Rs_Common = New ADODB.Recordset
          Rs_Common.Open "select * from Area_Customer_Delete", Cn_Common, adOpenKeyset, adLockOptimistic, adCmdText
          If Rs_Common.RecordCount <> 0 Then
            Rs_Common.MoveLast
            Rs_Common.AddNew
            Rs_Common.Fields("删除时间") = Now
            Rs_Common.Fields("删除操作员") = OperatorName
            Rs_Common.Fields("地区编码") = Rs.Fields("地区编码")
            Rs_Common.Fields("地区名称") = Rs.Fields("地区名称")
            Rs_Common.Fields("客户编码") = Rs.Fields("客户编码")
            Rs_Common.Fields("客户名称") = Rs.Fields("客户名称")
            Rs_Common.Update
          Else
            Rs_Common.AddNew
            Rs_Common.Fields("删除时间") = Now
            Rs_Common.Fields("删除操作员") = OperatorName
            Rs_Common.Fields("地区编码") = Rs.Fields("地区编码")
            Rs_Common.Fields("地区名称") = Rs.Fields("地区名称")
            Rs_Common.Fields("客户编码") = Rs.Fields("客户编码")
            Rs_Common.Fields("客户名称") = Rs.Fields("客户名称")
            Rs_Common.Update
          End If
          Rs_Common.Close
          Cn_Common.Close
        End If
        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 '%'+ '" & Left(AreaCustomer_Key, 5) & "'+'%' order by 内编码", Cn, adOpenKeyset, adLockOptimistic, adCmdText
        If Rs.RecordCount > 0 Then '对地区代码/地区名/客户代码/赋值
          Rs.MoveFirst
          Do While Rs.EOF = False
            Rs.Delete
            Rs.Update
            Rs.MoveNext
          Loop
        End If
        Rs.Close
        Cn.Close
        
        '将地区客户表删除
        Set Cn = New ADODB.Connection
        Cn.Open Cs
        Set Rs = New ADODB.Recordset
        Rs.Open "select * from Area_Customer where 客户编码 = '" & Left(AreaCustomer_Key, 5) & "' order by 客户编码", Cn, adOpenKeyset, adLockOptimistic, adCmdText
        If Rs.RecordCount > 0 Then '对地区代码/地区名/客户代码/赋值
          Rs.MoveFirst
          Do While Rs.EOF = False
            Rs.Delete
            Rs.Update
            Rs.MoveNext
          Loop
        End If
        Rs.Close
        Cn.Close
        Me.Tvw_Customer.Nodes.Clear
        Call Tree_Change
'        MsgBox "客户删除成功!"
      End If
    End If
12345

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -