VB开发的ERP系统

    Combo_CostObject.Clear
    Do Until RecTemp.EOF
        Combo_CostObject.AddItem "(" + Trim(RecTemp.Fields("A")) + ")" + RecTemp.Fields("B")
        Combo_CostObjectCode(Combo_CostObject.NewIndex) = RecTemp.Fields("A")
        RecTemp.MoveNext
    Loop
    
    If Combo_CostObject.ListCount >= 1 Then
        Combo_CostObject.ListIndex = 0
    End If
End Sub
Sub CostScatter()                               '成本分配
    Dim SqlStr As String                        'SQL字符
    Dim Rec_CostScatter As New ADODB.Recordset  '临时记录集
    Dim Str_Formula As String                   '临时字符串
    Dim yhAnswer As Integer                     '提示返回值
    Dim RecTemp As New ADODB.Recordset          '临时记录集
    Dim Quantity As Double                      '数量
    Dim Cash As Currency                        '金额
    Dim CalOrder As Integer
    Dim Tsxx As String
    
    IsCombo = True
    Tsxx = "是否确认分配成本对象《" + Str_ObjectName + "》的数据?"
    yhAnswer = Xtxxts(Tsxx, 2, 2)
    If yhAnswer = 2 Then
        Exit Sub
    End If
    
    Screen.MousePointer = 11
    On Error GoTo Err:
    Cw_DataEnvi.DataConnect.BeginTrans
    '判断是否能进行分配
    SqlStr = "Select Max(CalOrder) AS A  From Cb_CostObject Where ObjectCode In " _
                & "(Select ObjectCode From Cb_ObjectComplete Where Auditing='1')"
    
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If IsNull(RecTemp.Fields("A")) Or RecTemp.Fields("A") = 0 Then
        CalOrder = 1
    Else
        CalOrder = RecTemp.Fields("A") + 1
    End If
    
    SqlStr = "Select CalOrder As A From Cb_CostObject Where ObjectCode='" + Str_ObjectCode + "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    
    If CalOrder < RecTemp.Fields("A") Then
        Tsxx = "上级对象还未分配,请先分配上级对象!"
        Call Xtxxts(Tsxx, 0, 1)
        Screen.MousePointer = 0
        Exit Sub
    End If
    
    Xt_Wait.Show
    Xt_Wait.Refresh
    '删除存在的数据
    Cw_DataEnvi.DataConnect.Execute ("Delete From Cb_CostScatter Where ObjectCode='" & Str_ObjectCode & "' And Year='" & Glo_Year & "' And Period='" & Glo_Period & "'")
    '有分配公式的数据
    SqlStr = "Select * From Cb_ScatterSet Where ObjectCode='" + Str_ObjectCode + "'"
    Set Rec_CostScatter = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    
    Do Until Rec_CostScatter.EOF

        '计算数量
        Str_Formula = Trim(Rec_CostScatter.Fields("QuScatterFormula"))
        If Str_Formula <> "" Then
            Str_Formula = Fn_Replace(Str_Formula, 0)
            '年月替换
            Str_Formula = Replace(Str_Formula, "本年", Glo_Year)
            Str_Formula = Replace(Str_Formula, "本月", Glo_Period)
            SqlStr = "Select " & Str_Formula & " As ReturnValue"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
            If Not Cxnrrec.EOF Then
                Quantity = IIf(IsNull(Cxnrrec.Fields("ReturnValue")), 0, Cxnrrec.Fields("ReturnValue"))
            Else
                Quantity = 0
            End If
        Else
            Quantity = 0
        End If

        '计算金额
        Str_Formula = Trim(Rec_CostScatter.Fields("MoScatterFormula"))
        If Str_Formula <> "" Then
            Str_Formula = Fn_Replace(Str_Formula, 0)
            '年月替换
            Str_Formula = Replace(Str_Formula, "本年", Glo_Year)
            Str_Formula = Replace(Str_Formula, "本月", Glo_Period)
            SqlStr = "Select " & Str_Formula & " As ReturnValue"
            Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(SqlStr)
            If Not Cxnrrec.EOF Then
                Cash = IIf(IsNull(Cxnrrec.Fields("ReturnValue")), 0, Cxnrrec.Fields("ReturnValue"))
            Else
                Cash = 0
            End If
        Else
            Cash = 0
        End If

        '写入数据
        If RecTemp.State = 1 Then RecTemp.Close
        RecTemp.Open "Select * From Cb_CostScatter Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
        RecTemp.AddNew
        RecTemp.Fields("Objectcode") = Rec_CostScatter.Fields("ObjectCode")
        RecTemp.Fields("ItemCode") = Rec_CostScatter.Fields("ItemCode")
        RecTemp.Fields("CenterCode") = Rec_CostScatter.Fields("CenterCode")
        RecTemp.Fields("Year") = Glo_Year
        RecTemp.Fields("Period") = Glo_Period
        RecTemp.Fields("ScatterQuantity") = Quantity
        RecTemp.Fields("ScatterMoney") = Cash
        RecTemp.Update

        Rec_CostScatter.MoveNext
    Loop
    
    '无分配公式的数据
    SqlStr = "Select * From Cb_CostGather " _
            & "Where Year=" + CStr(Glo_Year) + " And Period=" + CStr(Glo_Period) + " And Ltrim(CenterCode)+Rtrim(ItemCode) In " _
            & "(Select Ltrim(A.CenterCode)+Rtrim(A.ItemCode) From Cb_GatherSet A " _
            & "Inner Join Cb_CostStructure B " _
            & "On A.CenterCode=b.CenterCode And A.ItemCode=B.ItemCode And ObjectCode='" + Str_ObjectCode + "') " _
            & "And Ltrim(CenterCode)+Rtrim(ItemCode) Not In " _
            & "(Select Ltrim(CenterCode)+Rtrim(ItemCode)  " _
            & "From Cb_CostScatter Where ObjectCode='" + Str_ObjectCode + "'   " _
            & "And Year=" + CStr(Glo_Year) + " And Period=" + CStr(Glo_Period) + ")"
    Set Rec_CostScatter = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    
    Do Until Rec_CostScatter.EOF
        If RecTemp.State = 1 Then RecTemp.Close
        RecTemp.Open "Select * From Cb_CostScatter Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockPessimistic
        RecTemp.AddNew
        RecTemp.Fields("Objectcode") = Str_ObjectCode
        RecTemp.Fields("ItemCode") = Rec_CostScatter.Fields("ItemCode")
        RecTemp.Fields("CenterCode") = Rec_CostScatter.Fields("CenterCode")
        RecTemp.Fields("Year") = Glo_Year
        RecTemp.Fields("Period") = Glo_Period
        RecTemp.Fields("ScatterQuantity") = 0
        RecTemp.Fields("ScatterMoney") = 0
        RecTemp.Update
        Rec_CostScatter.MoveNext
    Loop
    
    Call CostDataCollect                        '成本数据汇总
    Cw_DataEnvi.DataConnect.CommitTrans
    Xt_Wait.Hide
    Screen.MousePointer = 0
    Exit Sub
Err:
    Screen.MousePointer = 0
    Cw_DataEnvi.DataConnect.RollbackTrans
End Sub
Sub CostDataCollect()                           '成本数据汇总
    Dim DimYear As Integer
    Dim DimMM As Integer
    Dim CostThmonYcl As Double
    Dim CostTotalLjcl As Double
    DimMM = Glo_Period - 1
    If DimMM = 0 Then
        DimYear = Glo_Year - 1
        DimMM = 12
    Else
        DimYear = Glo_Year
    End If
    '求月产量,累计产量
    SqlStr = "Select Quantity From Cb_ObjectComplete Where ObjectCode='" + Str_ObjectCode + "'  " _
                & "And Year='" + CStr(Glo_Year) + "' And Period='" + CStr(Glo_Period) + "'"
                
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If Not RecTemp.EOF Then
        If IsNull(RecTemp.Fields("Quantity")) Then
            CostThmonYcl = 0
        Else
            CostThmonYcl = RecTemp.Fields("Quantity")
        End If
    Else
        CostThmonYcl = 0
    End If
    
    SqlStr = "Select Sum(Quantity) As CL From Cb_ObjectComplete Where ObjectCode='" + Str_ObjectCode + "'  " _
                    & "And Year='" + CStr(Glo_Year) + "' And Period<='" + CStr(Glo_Period) + "'"
                    
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    If Not RecTemp.EOF Then
        If IsNull(RecTemp.Fields("CL")) Then
            CostTotalLjcl = 0
        Else
            CostTotalLjcl = RecTemp.Fields("CL")
        End If
    Else
        CostTotalLjcl = 0
    End If
    '对象编码,当前年,当前月,(当前年),(上一月),月产量,累计产量
    '对象明细表
    SqlStr = "Delete From Cb_Sccbb Where ObjectCode='" + Str_ObjectCode + "' And Year=" + CStr(Glo_Year) + " And  " _
                & "Period=" + CStr(Glo_Period) + " Insert Into Cb_Sccbb Select Objectcode,ItemCode,ParentCode,Year, " _
                & "Period,UnitCode,PlanUnitPrice,PlanQuantity,PlanMoney,PreMonAmount,PreMonMoney,ScatterQuantity, " _
                & "ScatterMoney,InvQuantity,InvValue,ThmonConsumeAmount,ThmonConsumeMoney,ThMonFactUnAmount, " _
                & "ThMonFactUnMoney,TotalConsumeAmount,TotalConsumeMoney,TotalConsumeUnAmount,TotalConsumeUnMoney, " _
                & "ThMonRatioAmount,ThMonRatioMoney,TotalRationAmount,TotalRationMoney,IsSum,IsShow From  " _
                & "Cb_Fn_Sccb('" + Str_ObjectCode + "'," + CStr(Glo_Year) + "," + CStr(Glo_Period) + ", " _
                & "" + CStr(DimYear) + "," + CStr(DimMM) + "," + CStr(CostThmonYcl) + "," + CStr(CostTotalLjcl) + ")"
    
    '本年累计数量
    '
    SqlStr = SqlStr + " Update Cb_ObjectComplete Set TotalQuantity=B.TotalQuantity,LYearAver=B.LYearAver, " _
                & "ThmonUnitCost=B.ThmonUnitCost,ThmonCost=B.ThmonCost,TotalCost=B.TotalCost,TYearAver=B.TYearAver " _
                & "From Cb_ObjectComplete A,Cb_Fn_CostCollect('" + Str_ObjectCode + "'," + CStr(Glo_Year) + ", " _
                & "" + CStr(Glo_Period) + ") B Where A.ObjectCode=B.ObjectCode And A.Year=B.Year And A.Period=B.Period  " _
                & "And A.ObjectCode='" + Str_ObjectCode + "' And A.Year=" + CStr(Glo_Year) + " And  " _
                & "A.Period=" + CStr(Glo_Period) + ""
                
    Cw_DataEnvi.DataConnect.Execute SqlStr
End Sub