VB开发的ERP系统

            If Not Yesno = 1 Then
                GoTo Error_manage
            End If
            
        End If
    End If
    
    On Error GoTo Error_manage
    
    Cw_DataEnvi.DataConnect.BeginTrans
 
 '****************全月平均法
      
    '回填出库单
    SQLstr1 = Replace(AvgQuery_Cond, "view", "Chhs_Mate", 1, , vbTextCompare)
    SqlStr = "SELECT * FROM Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' and  " + SQLstr1
    Set Rectemp(0) = Cw_DataEnvi.DataConnect.Execute(SqlStr)
         
    Do While Not Rectemp(0).EOF
        
        '回填收发记录出库单
        SqlStr = "SELECT InOutMainId,InOutSubId,IssueMoney FROM Chhs_V_InOut WHERE Period='" & Now_period & "' AND KjYear='" & PGKjYear & "' " & _
                 " and WhCode='" & Trim(Rectemp(0).Fields("WhCode")) & "' " & _
                 " and MNumber='" & Trim(Rectemp(0).Fields("MNumber")) & "'" & _
                 " and (BillCode='1204' or BillCode='1205' or BillCode='1206') "
        Set Rectemp(1) = Cw_DataEnvi.DataConnect.Execute(SqlStr)
        
        Do While Not Rectemp(1).EOF
            
            If SFjezt Then      '处理实发金额自填
                If Rectemp(1).Fields("issuemoney") = 0 Then
                    If Rectemp(2).State = 1 Then Rectemp(2).Close
                    SqlStr = "SELECT Price,IssueMoney,FactIssueQuan from GY_InOutSub WHERE InOutMainId='" & Rectemp(1).Fields("InOutMainId") & "' AND InOutSubId='" & Rectemp(1).Fields("InOutSubId") & "'"
                    Rectemp(2).Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
                    If Not Rectemp(2).EOF Then
                        Rectemp(2).Fields("Price") = Format(Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtdjxsws, "0"))
                        Rectemp(2).Fields("IssueMoney") = Format(Val(Rectemp(2).Fields("FactIssueQuan")) * Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtjexsws, "0"))
                        Rectemp(2).UpdateBatch
                    End If
                    
                    '回填明细帐出库单
                    If Rectemp(3).State = 1 Then Rectemp(3).Close
                    SqlStr = "SELECT OutPrice,OutMoney FROM Chhs_List WHERE InOutMainId='" & Rectemp(1).Fields("InOutMainId") & "' AND InOutSubId='" & Rectemp(1).Fields("InOutSubId") & "'"
                    Rectemp(3).Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
                    If Not Rectemp(3).EOF Then
                        Rectemp(3).Fields("OutPrice") = Format(Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtdjxsws, "0"))
                        Rectemp(3).Fields("OutMoney") = Format(Val(Rectemp(2).Fields("FactIssueQuan")) * Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtjexsws, "0"))
                        Rectemp(3).UpdateBatch
                    End If
                End If
            Else
                If Rectemp(2).State = 1 Then Rectemp(2).Close
                SqlStr = "SELECT Price,IssueMoney,FactIssueQuan from GY_InOutSub WHERE InOutMainId='" & Rectemp(1).Fields("InOutMainId") & "' AND InOutSubId='" & Rectemp(1).Fields("InOutSubId") & "'"
                Rectemp(2).Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
                If Not Rectemp(2).EOF Then
                    Rectemp(2).Fields("Price") = Format(Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtdjxsws, "0"))
                    Rectemp(2).Fields("IssueMoney") = Format(Val(Rectemp(2).Fields("FactIssueQuan")) * Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtjexsws, "0"))
                    Rectemp(2).UpdateBatch
                End If
                
                '回填明细帐出库单
                If Rectemp(3).State = 1 Then Rectemp(3).Close
                SqlStr = "SELECT OutPrice,OutMoney FROM Chhs_List WHERE InOutMainId='" & Rectemp(1).Fields("InOutMainId") & "' AND InOutSubId='" & Rectemp(1).Fields("InOutSubId") & "'"
                Rectemp(3).Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
                If Not Rectemp(3).EOF Then
                    Rectemp(3).Fields("OutPrice") = Format(Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtdjxsws, "0"))
                    Rectemp(3).Fields("OutMoney") = Format(Val(Rectemp(2).Fields("FactIssueQuan")) * Val(Rectemp(0).Fields("EndPrice")), "####.0" + String(Xtjexsws, "0"))
                    Rectemp(3).UpdateBatch
                End If
            End If
            Rectemp(1).MoveNext
        Loop
        Rectemp(0).MoveNext
    Loop
         
    '***********修改期末处理月份
    SQLstr1 = Replace(Query_Cond, "view", "GY_WareHouse", 1, , vbTextCompare)
    SqlStr = "UPDATE GY_WareHouse SET EndDealFlagChhs=1 WHERE " + SQLstr1
    Cw_DataEnvi.DataConnect.Execute (SqlStr)

    '调整总帐
    Call Tzzz
    
    '向物料表中填写出库成本
    Call NewOutCost
     
    Cw_DataEnvi.DataConnect.CommitTrans
     
    '刷新列表框
    Call AddWarehouseName
     
    
     
    Tsxx = "期末处理完毕!"
    Call Xtxxts(Tsxx, 0, 4)
    
    Label1.Visible = False
    
    Set Rectemp(0) = Nothing
    Set Rectemp(1) = Nothing
    Set Rectemp(2) = Nothing
    Set Rectemp(3) = Nothing
    Set Rectemp(4) = Nothing
    Set Rectemp(5) = Nothing
    
    Exit Sub
 
  
Error_manage:

    Call ClearZG
    Call ClearPJDJ
    Call ClearCYJZ
    '调整总帐
    Call Tzzz
    Label1.Visible = False
    Tsxx = "期末处理失败,请稍候再试!"
    Call Xtxxts(Tsxx, 0, 1)
  
End Sub

Private Sub ClearZG()   '处理失败，删除已生成暂估单
    
    Dim Rectemp As New ADODB.Recordset
    Dim SqlStr As String
    Dim SQLstr1 As String
    Dim Now_period As Long           '当前月份
    
    Now_period = PGNowmon
    
    SQLstr1 = Replace(Query_Cond, "view", "Chhs_List", 1, , vbTextCompare)
    SqlStr = "DELETE Chhs_List WHERE KjYear='" & PGKjYear & "' AND Period='" & Now_period & "' AND (BillCode='1304' or BillCode='1306') AND  " + SQLstr1
    Cw_DataEnvi.DataConnect.Execute (SqlStr)
    If Now_period = LastMon Then
        SqlStr = "SELECT Period FROM GY_Kjrlb WHERE Kjyear=" & PGKjYear + 1 & " AND BeginFlag=1"
        Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
        If Not Rectemp.EOF Then
            SqlStr = "DELETE Chhs_List WHERE KjYear='" & PGKjYear + 1 & "' AND Period='" & Rectemp.Fields("Period") & "' AND BillCode='1305'  AND  " + SQLstr1
            Cw_DataEnvi.DataConnect.Execute (SqlStr)
        End If
    Else
        SqlStr = "DELETE Chhs_List WHERE KjYear='" & PGKjYear & "' AND Period='" & Now_period + 1 & "' AND BillCode='1305'  AND  " + SQLstr1
        Cw_DataEnvi.DataConnect.Execute (SqlStr)
    End If
    
    Set Rectemp = Nothing
    
End Sub

Private Sub ClearPJDJ()                          '计算标记为真时，清除计算的全月平均单价

    Dim SqlStr As String
    Dim SQLstr1 As String
    Dim Now_period As Long           '当前月份
    
    Now_period = PGNowmon
    
    If Price_Flag Then
        SQLstr1 = Replace(AvgQuery_Cond, "view", "Chhs_Mate", 1, , vbTextCompare)
        SqlStr = "UPDATE Chhs_Mate SET EndPrice=0 WHERE KjYear='" & PGKjYear & "' AND Period ='" & Now_period & "' AND " + SQLstr1
        Cw_DataEnvi.DataConnect.Execute (SqlStr)
    End If

End Sub

Private Sub ClearCYJZ()
    
    Dim SqlStr As String
    Dim SQLstr1 As String
    Dim Now_period As Long           '当前月份
    
    Now_period = PGNowmon
    
    '清除差异结转单
    SQLstr1 = Replace(PlanQuery_Cond, "view", "Chhs_DiffBill", 1, , vbTextCompare)
    SqlStr = "DELETE Chhs_DiffBill WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' AND " + SQLstr1
    Cw_DataEnvi.DataConnect.Execute (SqlStr)
    
    '清除明细帐中的差异结转单
    SQLstr1 = Replace(PlanQuery_Cond, "view", "Chhs_List", 1, , vbTextCompare)
    SqlStr = "DELETE Chhs_List WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' and BillCode='1307' AND  " + SQLstr1
    Cw_DataEnvi.DataConnect.Execute (SqlStr)

End Sub

Private Function PdAvgprice() As Boolean     '全月平均单价判断
 
    Dim Rectemp As Recordset
    Dim Rec_Query As Recordset
    Dim Rec_Hz As New ADODB.Recordset
 
    Dim mMoney As Double          '金额
    Dim mQuan As Double           '数量
    Dim mOutQuan As Double        '出库数量
    Dim Avgprice As Double        '全月平均单价
 
    Dim SqlStr As String
    Dim SQLstr1 As String
    Dim Now_period As Long
 
    PdAvgprice = False
    
    Now_period = PGNowmon
    
    mQuan = 0
    mMoney = 0
    mOutQuan = 0
    
    Price_Flag = False
    
    '期初结存和本月收入的数量和金额
    If Rec_Hz.State = 1 Then Rec_Hz.Close
    SQLstr1 = Replace(AvgQuery_Cond, "view", "Chhs_Mate", , , vbTextCompare)
    
    If Not CallFlag Then
        Price_Flag = True
        SqlStr = "SELECT * FROM Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period ='" & Now_period & "' and EndPrice=0 and " + SQLstr1
    Else
        SqlStr = "SELECT * FROM Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period ='" & Now_period & "' and " + SQLstr1
    End If
    
    Rec_Hz.Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
    
    If Rec_Hz.EOF Then
        If Not CallFlag Then
            PdAvgprice = True
        End If
        Exit Function
    End If
    
    Jsqte = 0
    
    On Error GoTo LabelErr
    
    Cw_DataEnvi.DataConnect.BeginTrans
    
    Do While Not Rec_Hz.EOF
    
        RecCount = Rec_Hz.RecordCount
        Avgprice = 0
       
        mQuan = Val(Rec_Hz.Fields("StartQuan")) + Val(Rec_Hz.Fields("InQuan"))
        mMoney = Val(Rec_Hz.Fields("StartMoney")) + Val(Rec_Hz.Fields("InMoney")) - Val(Rec_Hz.Fields("OutMoney"))
        mOutQuan = Val(Rec_Hz.Fields("OutQuan"))
        
        If Not mOutQuan = 0 Then
        
            '平均单价计算是否包括本期暂估,不包括减掉
            If Not Xtclzg Then
                SqlStr = "SELECT InQuan,InMoney FROM Chhs_List WHERE WhCode='" & Trim(Rec_Hz.Fields("WhCode")) & "' " & _
                         " and MNumber='" & Trim(Rec_Hz.Fields("MNumber")) & "' " & _
                         " and KjYear='" & PGKjYear & "' and Period='" & Now_period & "' " & _
                         " and (BillCode='1304' or BillCode='1305'or BillCode='1306') AND StartFlag=0"
                Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)
               
                Do While Not Rec_Query.EOF
                    mQuan = mQuan - (Val(Rec_Query.Fields("InQuan")))
                    mMoney = mMoney - Val(Rec_Query.Fields("InMoney"))
                    Rec_Query.MoveNext
                Loop
            End If
              
            '实发金额自填 数量、金额
            If SFjezt Then
                SqlStr = "SELECT OutQuan,OutMoney FROM Chhs_List WHERE WhCode='" & Trim(Rec_Hz.Fields("WhCode")) & "'" & _
                        " and MNumber='" & Trim(Rec_Hz.Fields("MNumber")) & "' and Period='" & Now_period & "'" & _
                        " and KjYear='" & PGKjYear & "' and  SfjeztFlag=1 "
                Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
                
                Do While Not Rectemp.EOF
                    mQuan = mQuan - Val(Rectemp.Fields("OutQuan"))
                    Rectemp.MoveNext
                Loop
            End If
            
            '计算平均单价
            If mQuan <> 0 Then
                Avgprice = Format((mMoney) / (mQuan), "####." + String(Xtdjxsws, "0"))
                
                '期末处理时退出计算过程
                If Avgprice <= 0 And Not CallFlag Then
                    GoTo LabelErr
                    Exit Function
                End If
            Else
                
                '期末处理数量等于零时退出计算过程
                If Not CallFlag Then
                    GoTo LabelErr
                    Exit Function
                End If
              
            End If
             
            '回填单价
            Cw_DataEnvi.DataConnect.Execute ("Update Chhs_Mate set EndPrice='" & Avgprice & "' where MateId='" & Rec_Hz.Fields("MateId") & "'")
        Else
            Jsqte = Jsqte + 1
        End If
        Rec_Hz.MoveNext
           
    Loop
      
    Cw_DataEnvi.DataConnect.CommitTrans
    If Jsqte = RecCount Then
        Tsxx = "采用全月平均法核算的仓库本月无出库!"
    End If
    PdAvgprice = True
    Set Rectemp = Nothing
    Set Rec_Query = Nothing
    Set Rec_Hz = Nothing
    
    Exit Function
    
LabelErr:

    Cw_DataEnvi.DataConnect.RollbackTrans