form1.frm

简单的商场优惠摊派金额,能显示具体到每个柜台的应该返还给消费者的金额.

ElseIf TreeView1.SelectedItem.Parent.Parent.Key = "scdl" Then
   
   d = MsgBox("你确定要删除这个商场吗？", vbOKCancel, "消息提示框")
   If d = 1 Then
    
    '------------------------------------------------------------qqqqqqqqqqq
    If TreeView1.SelectedItem.Children > 0 Then '1
     
       '删除商场下面的柜组
       Adodc3.Recordset.MoveFirst
       For i = 1 To Adodc3.Recordset.RecordCount
       If Adodc3.Recordset.Fields("mkt_id") = Left(TreeView1.SelectedItem.Key, 6) Then
        '-----------------------------------------------------------------
       '删除消费者信息
       tmp = Adodc3.Recordset.Fields("gz_id")
       cn.Open
       cn.Execute ("alter table customer drop column " & tmp)
       cn.Execute ("alter table customer drop column " & tmp + "tp")
       cn.Close
       Adodc4.Refresh
       DataGrid4.Refresh
        Call tanpai
       If Adodc4.Recordset.Fields.Count = 2 Then
        cn.Open
        cn.Execute ("delete * from customer where customer")
       cn.Close
       Adodc4.Refresh
       DataGrid4.Refresh
       End If
       '------------------------------------------------------------------
       Adodc3.Recordset.Delete
       Adodc3.Recordset.Update
       End If
        Adodc3.Recordset.MoveNext
        Next i
        End If '1
       
       
       '删除商场
       Adodc2.Recordset.MoveFirst
       For i = 1 To Adodc2.Recordset.RecordCount
       If Adodc2.Recordset.Fields("mkt_id") = Left(TreeView1.SelectedItem.Key, 6) Then
       Adodc2.Recordset.Delete
       Adodc2.Recordset.Update
       End If
        Adodc2.Recordset.MoveNext
        Next i
    '------------------------------------------------------------qqqqqqqqqqqqqqqqqqq
    TreeView1.Nodes.Remove TreeView1.SelectedItem.Index
    End If

ElseIf TreeView1.SelectedItem.Parent.Parent.Parent.Key = "scdl" Then
   
   d = MsgBox("你确定要删除这个柜组吗？", vbOKCancel, "消息提示框")
   If d = 1 Then
    
    '------------------------------------------------------------sssssssssssss
    If Adodc3.Recordset.RecordCount > 0 Then '3
     
       '删除消费者信息
       If Adodc4.Recordset.Fields.Count > 1 Then
      dm = Left(TreeView1.SelectedItem.Key, 6)
      cn.Open
      cn.Execute ("alter table customer drop column " & dm)
      cn.Execute ("alter table customer drop column " & dm + "tp")
      cn.Close
      Adodc4.Refresh
      DataGrid4.Refresh
       Call tanpai
      End If
      If Adodc4.Recordset.Fields.Count = 2 Then
        cn.Open
        cn.Execute ("delete * from customer where customer")
       cn.Close
       Adodc4.Refresh
       DataGrid4.Refresh
       End If
    Adodc3.Recordset.MoveFirst
    For i = 1 To Adodc3.Recordset.RecordCount
    If Adodc3.Recordset.Fields("gz_id") = Left(TreeView1.SelectedItem.Key, 6) Then
    Adodc3.Recordset.Delete
    Adodc3.Recordset.Update
    End If
    Adodc3.Recordset.MoveNext
    Next i
    End If '3
    '------------------------------------------------------------ssssssssssssss
    TreeView1.Nodes.Remove TreeView1.SelectedItem.Index
    End If

End If
 
End Sub

Private Sub Command3_Click()
Dim d As String
Dim cf As Boolean
Dim mn As String
Dim l As Integer
If TreeView1.SelectedItem.Key = "scdl" Then
    
    MsgBox "请不要修改商场大楼。", , "消息提示框"
ElseIf TreeView1.SelectedItem.Parent.Key = "scdl" Then
 MsgBox "楼层名字不需要修改。", , "提示"
ElseIf TreeView1.SelectedItem.Parent.Parent.Key = "scdl" Then
   
   d = InputBox("请输入  修改商场  的名字", "信息提示")
   If d <> "" Then
     For i = 1 To TreeView1.Nodes.Count
         mn = TreeView1.Nodes(i).Text
         l = Len(TreeView1.Nodes(i).Text)
        If Mid(mn, 7, l - 6) = d + "商场" Then

         MsgBox "输入的商场名重复了！请重新修改！", , ""
         cf = True
        Exit For
        End If
    Next i
      If cf = False Then
    
    TreeView1.SelectedItem.Text = Left(TreeView1.SelectedItem.Text, 6) + d + "商场"
    
    '------------------------------------------------------------
        Adodc2.Recordset.MoveFirst
     For i = 1 To Adodc2.Recordset.RecordCount
         If Adodc2.Recordset.Fields("mkt_id") = Left(TreeView1.SelectedItem.Key, 6) Then
         Adodc2.Recordset.Fields("mkt") = d
         Adodc2.Recordset.MoveNext
         End If
    Next i
    '------------------------------------------------------------
    End If
End If
ElseIf TreeView1.SelectedItem.Parent.Parent.Parent.Key = "scdl" Then
   MsgBox "柜组编号不要修改。", , "提示"
   
End If
   

End Sub

Private Sub Command4_Click()
End
End Sub

Private Sub Command5_Click()
Load Form3
Form3.Show
End Sub

Private Sub Command6_Click()
Adodc3.Refresh
Adodc4.Refresh
If Adodc3.Recordset.RecordCount = 0 Then
MsgBox "没有柜组", , "提示"
ElseIf Adodc4.Recordset.RecordCount = 0 Then
MsgBox "柜组中的数据为空！", , "提示"
Else
Load Form4
Form4.Show
End If
End Sub


Private Sub Command1_Click()
Dim nx As Node
Dim d As Integer
Dim tmp As String
Dim scm As String
Dim cf As Boolean
Dim dm As String
Dim tt As String
'-------------------------------------------------------------------------------------------------------
Dim cn As New ADODB.Connection

cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path & "\market.mdb;"


'--------------------------------------------------------------------------------------------------------
If TreeView1.SelectedItem.Key = "scdl" Then

   d = MsgBox("你想新增一个楼层吗？", vbOKCancel, "消息提示框")
   If d = 1 Then '1
   tmp = InputBox("请输入  楼层  对应的代码(两位)", "提示")
     If Len(tmp) <> 2 Or IsNumeric(tmp) <> True Then '2
       MsgBox "楼层代码格式错误，必须是两位的数字，请重新添加", , "提示"
     Else
       If TreeView1.SelectedItem.Children > 0 Then '3
    For i = 1 To TreeView1.Nodes.Count
         If Left(TreeView1.Nodes(i).Text, 2) = tmp Then '4
         MsgBox "输入了重复的楼层，请重新添加", , "提示"
         cf = True
         Exit For
         End If '4
     Next i
       End If '3
             If cf = False Then '5
                dm = tmp + "0000"
                Set nx = TreeView1.Nodes.Add(TreeView1.SelectedItem.Key, 4, dm + "lc", dm + "楼层" + Mid(tmp, 2, 1))
                TreeView1.SelectedItem.Expanded = True
                MsgBox "您添加的楼层已成功加入，商场结构已更新！", , "添加成功"
                '------------------------------------------------------------------------------------
                Adodc1.Recordset.AddNew
                Adodc1.Recordset.Fields("lc_id") = dm
                Adodc1.Recordset.Fields("lc") = "楼层" + Mid(tmp, 2, 1)
                Adodc1.Recordset.Update
                '------------------------------------------------------------------------------------
             End If '5
       End If '2
     End If '1

ElseIf TreeView1.SelectedItem.Parent.Key = "scdl" Then
   
   d = MsgBox("你想新增一个商场吗？", vbOKCancel, "消息提示框")
   If d = 1 Then
    tmp = InputBox("请输入  商场  对应的代码(两位)", "提示")
       If Len(tmp) <> 2 < 0 Or IsNumeric(tmp) <> True Then
       MsgBox "商场代码格式错误，必须是两位的数字，请重新添加", , "提示"
       Else
          
             If TreeView1.SelectedItem.Children > 0 Then '3
              For i = 2 To TreeView1.Nodes.Count
             
             If (TreeView1.Nodes(i).Parent = TreeView1.SelectedItem) And (Mid(TreeView1.Nodes(i).Text, 3, 2) = tmp) Then   '4
             MsgBox "输入了重复的商场，请重新填加", , "提示"
             cf = True
             Exit For
             End If '4
            Next i
       End If '3
             If cf = False Then '5
                
             scm = InputBox("请输入  新建商场  的名字", "信息提示")
          If scm <> "" Then
          For i = 1 To TreeView1.Nodes.Count
             tt = Right(TreeView1.Nodes(i).Text, Len(TreeView1.Nodes(i).Text) - 6) '判断输入的商场名是否重复
            If tt = scm + "商场" Then

             MsgBox "输入的商场已存在！请添加其他类型的商场！", , ""
             cf = True
              Exit For
          End If
          Next i
         If cf = False Then
         dm = Left(TreeView1.SelectedItem.Text, 2) + tmp + "00"
         Set nx = TreeView1.Nodes.Add(TreeView1.SelectedItem.Key, 4, dm + "mkt", dm + scm + "商场")
          TreeView1.SelectedItem.Expanded = True
          MsgBox "您添加的商场已成功加入，商场结构已更新！", , "添加成功"
          End If
         End If
      
       '-------------------------------------------------------------------------------------------
       Adodc2.Recordset.AddNew
       Adodc2.Recordset.Fields("mkt_id") = dm
       Adodc2.Recordset.Fields("mkt") = scm
       Adodc2.Recordset.Fields("lc_id") = Left(TreeView1.SelectedItem.Key, 6)
       Adodc2.Recordset.Update
       '-------------------------------------------------------------------------------------------
        End If '5
          
          
         
       End If
   End If

ElseIf TreeView1.SelectedItem.Parent.Parent.Key = "scdl" Then
   
   d = MsgBox("你想新增一个柜组吗？", vbOKCancel, "消息提示框")
   If d = 1 Then
     tmp = InputBox("请输入  柜组  对应的代码(两位)", "提示")
       If Len(tmp) <> 2 < 0 Or IsNumeric(tmp) <> True Then
       MsgBox "柜组代码格式错误，必须是两位的数字，请重新添加", , "提示"
       Else
       If TreeView1.SelectedItem.Children > 0 Then '3
         For i = 2 To TreeView1.Nodes.Count
         If (TreeView1.Nodes(i).Parent = TreeView1.SelectedItem) And (Mid(TreeView1.Nodes(i).Text, 5, 2) = tmp) Then '4
         MsgBox "输入了重复的代码，请重新填加", , "提示"
         cf = True
         Exit For
         End If '4
     Next i
       End If '3
             If cf = False Then '5
                 dm = Left(TreeView1.SelectedItem.Text, 4) + tmp
                 Set nx = TreeView1.Nodes.Add(TreeView1.SelectedItem.Key, 4, dm + "gz", dm + "柜组" + Right(tmp, 1))
                 TreeView1.SelectedItem.Expanded = True
                 MsgBox "您添加的柜组已成功加入，商场结构已更新！", , "添加成功"
                 '-------------------------------------------------------------------------------------------------
                    Adodc3.Recordset.AddNew
                    Adodc3.Recordset.Fields("gz_id") = dm
                    Adodc3.Recordset.Fields("gz") = "柜组" + Right(tmp, 1)
                    Adodc3.Recordset.Fields("mkt_id") = Left(TreeView1.SelectedItem.Key, 6)
                    Adodc3.Recordset.Fields("lc_id") = Left(TreeView1.SelectedItem.Parent.Key, 6)
                    Adodc3.Recordset.Fields("income") = 0
                    Adodc3.Recordset.Fields("payout") = 0
                    Adodc3.Recordset.Update
                    cn.Open
                    cn.Execute ("alter table customer add column " & dm & " number") '在 customer表中是柜组名字是'dm'
                    cn.Execute ("alter table customer add column " & dm + "tp" & " number")
                    cn.Execute ("update customer set " & dm & " = 0")         '初始化
                    cn.Execute ("update customer set " & dm + "tp" & " = 0")
                    cn.Close
                    Adodc4.Refresh
                    DataGrid4.Refresh
                    
                    
                 '-------------------------------------------------------------------------------------------------
             End If '5
       
       
       
    
   End If
   End If
ElseIf TreeView1.SelectedItem.Parent.Parent.Parent.Key = "scdl" Then
   MsgBox "不好意思，柜组是最小单位了！不能向下添加了。", , ""
   

End If
End Sub

Private Sub tanpai()
Dim i As Integer
Dim j As Integer
Dim sum As Long
'---------------------------------------------------------------------------------------
       '以下是摊派金额
     If Form1.Adodc4.Recordset.Fields.Count > 2 Then
     
     Form1.Adodc4.Recordset.MoveFirst
  
    For j = 1 To Form1.Adodc4.Recordset.RecordCount
    sum = 0
    ct = Form1.Adodc4.Recordset.Fields.Count
    
    For i = 2 To ct - 2 Step 2
      If Form1.Adodc4.Recordset.Fields(i) <> 0 Then '11
      sum = sum + Form1.Adodc4.Recordset.Fields(i)
      End If '11
    Next i
        Form1.Adodc4.Recordset.Fields("spend") = sum
      For i = 2 To ct - 2 Step 2
         If Form1.Adodc4.Recordset.Fields(i) <> 0 Then '12
            
            Form1.Adodc4.Recordset.Fields(i + 1) = Form1.Adodc4.Recordset.Fields(i) / sum * 30 * (sum \ 200)
            
          End If '12
      Next i
       
       Form1.Adodc4.Recordset.MoveNext
    Next j
     '------------------------------------------------------------------------------------------
    Else
    End If
End Sub