VB开发的ERP系统

    Label1.Visible = False
    PdAvgprice = False
    Tsxx = "全月平均单价小于等于零时,不允许期末处理!"
    Call Xtxxts(Tsxx, 0, 1)

End Function

Private Sub Tzzz()   '调整总帐
  
    Dim RecQc As New ADODB.Recordset            '期初记录
    Dim RecSummx As New ADODB.Recordset         '汇总明细帐
    Dim Reczz As New ADODB.Recordset            '总帐
    Dim RecZzfz As New ADODB.Recordset          '总帐
    Dim Now_period As Long
    Dim SqlStr As String

    Now_period = PGNowmon
  
    '打开总帐表
    If Reczz.State = 1 Then Reczz.Close
    Reczz.Open "SELECT * FROM Chhs_Mate ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
    
    '清除总帐本月发生数据
    SqlStr = Replace(Query_Cond, "view", "Chhs_Mate", , , vbTextCompare)
    Cw_DataEnvi.DataConnect.Execute ("DELETE Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' AND  StartQuan=0 AND " + SqlStr)
    Cw_DataEnvi.DataConnect.Execute ("UPDATE Chhs_Mate SET InQuan=0,Inprice=0,Inmoney=0 ," & _
                                     "OutQuan=0 ,OutPrice=0, OutMoney=0 ,JfDiff=0,Dfdiff=0 ,EndDiff=0,EndQuan=0," & _
                                     "EndPrice=0,EndMoney=0 WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' AND " + SqlStr)
     
    '汇总明细帐
    SqlStr = Replace(Query_Cond, "view", "Chhs_List", , , vbTextCompare)
    SqlStr = "SELECT WhCode,MNumber,KjYear,Period, SUM(InQuan) AS sum_recquan,SUM(InMoney) AS sum_recmoney, " & _
             "SUM(OutQuan) AS sum_outquan, SUM(OutMoney) AS sum_outmoney," & _
             "SUM(JfDiff) as sumjf_diff,SUM(DfDiff) AS sumdf_diff From Chhs_List " & _
             "WHERE Chhs_List.startflag=0 AND KjYear='" & PGKjYear & "' and Period='" & Now_period & "' and " + SqlStr & _
             " GROUP BY WhCode,MNumber,KjYear,Period "
    Set RecSummx = Cw_DataEnvi.DataConnect.Execute(SqlStr)
     
    Do While Not RecSummx.EOF
     
        '对比总帐中是否存在相同的仓库+物料
        SqlStr = "SELECT * FROM Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' " & _
                 "AND WhCode='" & Trim(RecSummx.Fields("WhCode")) & "' " & _
                 "AND MNumber='" & Trim(RecSummx.Fields("MNumber")) & "'"
        
        If RecQc.State = 1 Then RecQc.Close
        RecQc.Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
        
        If Not RecQc.EOF Then
        
            '加入发生额
            If Not IsNull(RecSummx.Fields("sum_recquan")) Then
               RecQc.Fields("InQuan") = Format(Val(RecSummx.Fields("sum_recquan")), "#####." + String(Xtslxsws, "0"))
            End If
            If Not Val(RecSummx.Fields("sum_recquan")) = 0 Then
               RecQc.Fields("InPrice") = Format(Val(RecSummx.Fields("sum_recmoney")) / Val(RecSummx.Fields("sum_recquan")), "#####." + String(Xtdjxsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sum_recmoney")) Then
               RecQc.Fields("InMoney") = Format(Val(RecSummx.Fields("sum_recmoney")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sum_outquan")) Then
               RecQc.Fields("OutQuan") = Format(Val(RecSummx.Fields("sum_outquan")), "#####." + String(Xtslxsws, "0"))
            End If
            If Not Val(RecSummx.Fields("sum_outquan")) = 0 Then
               RecQc.Fields("OutPrice") = Format(Val(RecSummx.Fields("sum_outmoney")) / Val(RecSummx.Fields("sum_outquan")), "#####." + String(Xtdjxsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sum_outmoney")) Then
               RecQc.Fields("OutMoney") = Format(Val(RecSummx.Fields("sum_outmoney")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sumjf_diff")) Then
               RecQc.Fields("JfDiff") = Format(Val(RecSummx.Fields("sumjf_diff")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sumdf_diff")) Then
               RecQc.Fields("Dfdiff") = Format(Val(RecSummx.Fields("sumdf_diff")), "#####." + String(Xtjexsws, "0"))
            End If
            RecQc.UpdateBatch
        
        Else
            
            '添加新记录
            Reczz.AddNew
            Reczz.Fields("WhCode") = Trim(RecSummx.Fields("WhCode"))
            Reczz.Fields("MNumber") = Trim(RecSummx.Fields("MNumber"))
            Reczz.Fields("KjYear") = PGKjYear
            Reczz.Fields("Period") = Val(RecSummx.Fields("Period"))
            
            Reczz.Fields("StartQuan") = 0
            Reczz.Fields("StartPrice") = 0
            Reczz.Fields("StartMoney") = 0
            
            Reczz.Fields("InQuan") = Format(Val(RecSummx.Fields("sum_recquan")), "#####." + String(Xtslxsws, "0"))
            If Not Val(RecSummx.Fields("sum_recquan")) = 0 Then
               Reczz.Fields("InPrice") = Format(Val(RecSummx.Fields("sum_recmoney")) / Val(RecSummx.Fields("sum_recquan")), "#####." + String(Xtdjxsws, "0"))
            End If
            Reczz.Fields("InMoney") = Format(Val(RecSummx.Fields("sum_recmoney")), "#####." + String(Xtjexsws, "0"))
            
            Reczz.Fields("OutQuan") = Format(Val(RecSummx.Fields("sum_outquan")), "#####." + String(Xtslxsws, "0"))
            If Not Val(RecSummx.Fields("sum_outquan")) = 0 Then
               Reczz.Fields("OutPrice") = Format(Val(RecSummx.Fields("sum_outmoney")) / Val(RecSummx.Fields("sum_outquan")), "#####." + String(Xtdjxsws, "0"))
            End If
            Reczz.Fields("OutMoney") = Format(Val(RecSummx.Fields("sum_outmoney")), "#####." + String(Xtjexsws, "0"))
            
            If Not IsNull(RecSummx.Fields("sumjf_diff")) Then
               Reczz.Fields("JfDiff") = Format(Val(RecSummx.Fields("sumjf_diff")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sumdf_diff")) Then
               Reczz.Fields("DfDiff") = Format(Val(RecSummx.Fields("sumdf_diff")), "#####." + String(Xtjexsws, "0"))
            End If
            
            Reczz.UpdateBatch
        End If
        
        RecSummx.MoveNext
     Loop

End Sub

Private Sub Tzzg()  '暂估单处理完后，调整总帐

    Dim RecQc As New ADODB.Recordset            '期初记录
    Dim RecSummx As New ADODB.Recordset         '汇总明细帐
    Dim Reczz As New ADODB.Recordset            '总帐
    Dim RecZzfz As New ADODB.Recordset          '总帐
    Dim Now_period As Long
    Dim SqlStr As String

    Now_period = PGNowmon
  
    '打开总帐表
    If Reczz.State = 1 Then Reczz.Close
    Reczz.Open "SELECT * FROM Chhs_Mate ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic

    '汇总明细帐
    SqlStr = Replace(Query_Cond, "view", "Chhs_List", , , vbTextCompare)
    SqlStr = "SELECT WhCode,MNumber,KjYear,Period, SUM(InQuan) AS sum_recquan,SUM(InMoney) AS sum_recmoney, " & _
             "SUM(OutQuan) AS sum_outquan, SUM(OutMoney) AS sum_outmoney," & _
             "SUM(JfDiff) as sumjf_diff,SUM(DfDiff) AS sumdf_diff From Chhs_List " & _
             "WHERE BillCode='1304' AND StartFlag<>1 AND KjYear='" & PGKjYear & "' and Period='" & Now_period & "' and " + SqlStr & _
             " GROUP BY WhCode,MNumber,KjYear,Period "
    Set RecSummx = Cw_DataEnvi.DataConnect.Execute(SqlStr)
     
    Do While Not RecSummx.EOF
     
        '对比总帐中是否存在相同的仓库+物料
        SqlStr = "SELECT * FROM Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' " & _
                 "AND WhCode='" & Trim(RecSummx.Fields("WhCode")) & "' " & _
                 "AND MNumber='" & Trim(RecSummx.Fields("MNumber")) & "'"
        
        If RecQc.State = 1 Then RecQc.Close
        RecQc.Open SqlStr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
        
        If Not RecQc.EOF Then
        
            '加入发生额
            If Not IsNull(RecSummx.Fields("sum_recquan")) Then
               RecQc.Fields("InQuan") = Format(Val(RecSummx.Fields("sum_recquan")) + Val(RecQc.Fields("InQuan")), "#####." + String(Xtslxsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sum_recmoney")) Then
               RecQc.Fields("InMoney") = Format(Val(RecSummx.Fields("sum_recmoney")) + Val(RecQc.Fields("InMoney")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not Val(RecQc.Fields("InQuan")) = 0 Then
               RecQc.Fields("InPrice") = Format(Val(RecQc.Fields("InMoney")) / Val(RecQc.Fields("InQuan")), "#####." + String(Xtdjxsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sumjf_diff")) Then
               RecQc.Fields("JfDiff") = Format(Val(RecSummx.Fields("sumjf_diff") + RecQc.Fields("JfDiff")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sumdf_diff")) Then
               RecQc.Fields("Dfdiff") = Format(Val(RecSummx.Fields("sumdf_diff") + RecQc.Fields("Dfdiff")), "#####." + String(Xtjexsws, "0"))
            End If
            RecQc.UpdateBatch
        
        Else
            
            '添加新记录
            Reczz.AddNew
            Reczz.Fields("WhCode") = Trim(RecSummx.Fields("WhCode"))
            Reczz.Fields("MNumber") = Trim(RecSummx.Fields("MNumber"))
            Reczz.Fields("KjYear") = PGKjYear
            Reczz.Fields("Period") = Val(RecSummx.Fields("Period"))
            
            Reczz.Fields("StartQuan") = 0
            Reczz.Fields("StartPrice") = 0
            Reczz.Fields("StartMoney") = 0
            
            Reczz.Fields("InQuan") = Format(Val(RecSummx.Fields("sum_recquan")), "#####." + String(Xtslxsws, "0"))
            If Not Val(RecSummx.Fields("sum_recquan")) = 0 Then
               Reczz.Fields("InPrice") = Format(Val(RecSummx.Fields("sum_recmoney")) / Val(RecSummx.Fields("sum_recquan")), "#####." + String(Xtdjxsws, "0"))
            End If
            Reczz.Fields("InMoney") = Format(Val(RecSummx.Fields("sum_recmoney")), "#####." + String(Xtjexsws, "0"))
            If Not IsNull(RecSummx.Fields("sumjf_diff")) Then
               Reczz.Fields("JfDiff") = Format(Val(RecSummx.Fields("sumjf_diff")), "#####." + String(Xtjexsws, "0"))
            End If
            If Not IsNull(RecSummx.Fields("sumdf_diff")) Then
               Reczz.Fields("DfDiff") = Format(Val(RecSummx.Fields("sumdf_diff")), "#####." + String(Xtjexsws, "0"))
            End If
            
            Reczz.UpdateBatch
        End If
        
        RecSummx.MoveNext
     Loop

End Sub

Private Function Djzgcl() As Boolean          '单据暂估处理
 
    Dim Rec As New ADODB.Recordset
    Dim Rectemp As New ADODB.Recordset
    Dim RecTempFz As New ADODB.Recordset
    Dim Rec_Mxz As New ADODB.Recordset
 
    Dim SqlStr As String
    Dim SQLstr1 As String
    Dim Now_period As Long
 
    Dim Glgjxztj As String                            '暂估条件
    Dim Glgjxztj1 As String
    
    Now_period = PGNowmon
    
    Djzgcl = False
    
     
    '暂估条件限制
    Set Rec = Cw_DataEnvi.DataConnect.Execute("SELECT * FROM Chhs_Evalu ORDER BY EvaluId")
    If Rec.EOF Then
        Djzgcl = True
        Exit Function
    End If
    
    Do While Not Rec.EOF
    
        If Trim(Rec.Fields("WhCode") & "") <> "" Then
            If Glgjxztj1 <> "" Then
                Glgjxztj1 = Glgjxztj1 + " and Chhs_V_StartEval.WhCode ='" & Trim(Rec.Fields("WhCode")) & "'"
            Else
                Glgjxztj1 = " Chhs_V_StartEval.WhCode ='" & Trim(Rec.Fields("WhCode")) & "'"
            End If
        End If
       
        If Trim(Rec.Fields("MSort") & "") <> "" Then
            If Glgjxztj1 <> "" Then
                Glgjxztj1 = Glgjxztj1 + " and Chhs_V_StartEval.InvSortCode like '" & Trim(Rec.Fields("MSort")) & "%'"
            Else
                Glgjxztj1 = " Chhs_V_StartEval.InvSortCode like '" & Trim(Rec.Fields("MSort")) & "%'"
            End If
        End If
       
        If Trim(Rec.Fields("MNumber") & "") <> "" Then
            If Glgjxztj1 <> "" Then
                Glgjxztj1 = Glgjxztj1 + " and  Chhs_V_StartEval.MNumber ='" & Trim(Rec.Fields("MNumber")) & "'"
            Else
                Glgjxztj1 = " Chhs_V_StartEval.MNumber ='" & Trim(Rec.Fields("MNumber")) & "'"
            End If
        End If
    
        Rec.MoveNext
        
        If Glgjxztj1 <> "" Then
            If Glgjxztj <> "" Then
                Glgjxztj = Glgjxztj + " OR " + "(" & Glgjxztj1 & ")"
            Else
                Glgjxztj = "(" & Glgjxztj1 & ")"
            End If
        End If
        
    Loop
    
    '明细帐
    If Rec_Mxz.State = 1 Then Rec_Mxz.Close
    Rec_Mxz.Open "SELECT * FROM Chhs_List where 1=0", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
    
    On Error GoTo LabelErr
    
    Cw_DataEnvi.DataConnect.BeginTrans
    
    '判断收发记录中是否存在暂估单
    SQLstr1 = Replace(Query_Cond, "view", "Chhs_V_StartEval", 1, , vbTextCompare)
    SqlStr = "SELECT * FROM Chhs_V_StartEval WHERE (BillCode='1201' or BillCode='1211') and (BalanceDate is null or BalanceDate='') " & _
             " and (Kjyear <" & PGKjYear & " or (Kjyear=" & PGKjYear & "  and Period<=" & PGNowmon & ")) AND EMoney<>0 and " + SQLstr1 + " AND " & Glgjxztj & " "
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    
    Do While Not Rectemp.EOF
       
        '查找明细帐中对应的记录（蓝字暂估单）
        SqlStr = "SELECT * FROM Chhs_List WHERE startflag=0 and InoutMainId='" & Rectemp.Fields("InoutMainId") & "' and InoutSubId='" & Rectemp.Fields("InoutSubId") & "' " & _
                 "and BillCode='1304' and Period='" & Now_period & "' AND KjYear='" & PGKjYear & "'"
        Set RecTempFz = Cw_DataEnvi.DataConnect.Execute(SqlStr)
        
        If RecTempFz.EOF Then

                
            '1-蓝字暂估单记明细帐
            Rec_Mxz.AddNew
            Rec_Mxz.Fields("InoutFlag") = Trim(Rectemp.Fields("InoutFlag"))
            If Trim(Rectemp.Fields("OperType") & "") <> "" Then
               Rec_Mxz.Fields("OperType") = Trim(Rectemp.Fields("OperType"))
            End If
            If Trim(Rectemp.Fields("OperbillNum") & "") <> "" Then
               Rec_Mxz.Fields("OperbillNum") = Trim(Rectemp.Fields("OperbillNum"))
            End If
            If Trim(Rectemp.Fields("BillNum") & "") <> "" Then
               Rec_Mxz.Fields("BillNum") = Trim(Rectemp.Fields("BillNum"))
            End If
            If Trim(Rectemp.Fields("InoutMainId") & "") Then
               Rec_Mxz.Fields("InoutMainId") = Trim(Rectemp.Fields("InoutMainId"))
            End If
            If Trim(Rectemp.Fields("InoutSubId") & "") Then
               Rec_Mxz.Fields("InoutSubId") = Trim(Rectemp.Fields("InoutSubId"))
            End If
            Rec_Mxz.Fields("BillDate") = Xtrq
            Rec_Mxz.Fields("ChalkDate") = Xtrq
            Rec_Mxz.Fields("KjYear") = Xtyear
            Rec_Mxz.Fields("Period") = Now_period
            Rec_Mxz.Fields("BillCode") = "1304"
            If Trim(Rectemp.Fields("PurTypeCode") & "") <> "" Then
                Rec_Mxz.Fields("PurTypeCode") = Trim(Rectemp.Fields("PurTypeCode"))