VB开发的ERP系统

            End If
            If Trim(Rectemp.Fields("WhCode") & "") <> "" Then
                Rec_Mxz.Fields("WhCode") = Trim(Rectemp.Fields("WhCode"))
            End If
            If Trim(Rectemp.Fields("DeptCode") & "") <> "" Then
                Rec_Mxz.Fields("DeptCode") = Trim(Rectemp.Fields("DeptCode"))
            End If
            If Trim(Rectemp.Fields("ReceiptNum") & "") <> "" Then
                Rec_Mxz.Fields("ReceiptNum") = Trim(Rectemp.Fields("ReceiptNum"))
            End If
            If Trim(Rectemp.Fields("PersonCode") & "") <> "" Then
                Rec_Mxz.Fields("Personcode") = Trim(Rectemp.Fields("PersonCode"))
            End If
            If Trim(Rectemp.Fields("InoutClassCode") & "") <> "" Then
                Rec_Mxz.Fields("InoutClassCode") = Trim(Rectemp.Fields("InoutClassCode"))
            End If
            If Trim(Rectemp.Fields("SupplierCode") & "") <> "" Then
                Rec_Mxz.Fields("SupplierCode") = Trim(Rectemp.Fields("SupplierCode"))
            End If
            If Trim(Rectemp.Fields("MNumber") & "") <> "" Then
                Rec_Mxz.Fields("MNumber") = Trim(Rectemp.Fields("MNumber"))
            End If
            Rec_Mxz.Fields("InQuan") = Val(Rectemp.Fields("FactReceiptQuan"))
             
            '以计划价法核算按计划价入库 ，以实际价核算的按实际价入库
            If Trim(Rectemp.Fields("PriceMode")) = "计划价法" And Qmclcy Then
                Rec_Mxz.Fields("InPrice") = Val(Rectemp.Fields("PlanPrice"))
                Rec_Mxz.Fields("Inmoney") = Val(Rectemp.Fields("PlanMoney"))
                
                If Val(Rectemp.Fields("EMoney")) - Val(Rectemp.Fields("PlanMoney")) > 0 Then
                   Rec_Mxz.Fields("JfDiff") = Val(Rectemp.Fields("Emoney")) - Val(Rectemp.Fields("PlanMoney"))
                Else
                   Rec_Mxz.Fields("DfDiff") = Val(Rectemp.Fields("PlanMoney")) - Val(Rectemp.Fields("Emoney"))
                End If
            Else
                Rec_Mxz.Fields("InPrice") = Val(Rectemp.Fields("Price"))
                Rec_Mxz.Fields("InMoney") = Val(Rectemp.Fields("EMoney"))
            End If
            
            If Trim(Rectemp.Fields("Maker") & "") <> "" Then
                Rec_Mxz.Fields("Maker") = Trim(Rectemp.Fields("Maker"))
            End If
            Rec_Mxz.Fields("checker") = Xtczy
            Rec_Mxz.Fields("ChalkitupMan") = Xtczy
            If Trim(Rectemp.Fields("Remark") & "") <> "" Then
                Rec_Mxz.Fields("Remark") = Trim(Rectemp.Fields("Remark"))
            End If
            
            '填写物料科目和差异科目
            Call MaccCode(Trim(Rectemp.Fields("WhCode") & ""), Trim(Rectemp.Fields("MNumber") & ""), Trim(Rectemp.Fields("InvSortcode") & ""))
            Rec_Mxz.Fields("MateAcct") = Xtfhcs
            If Trim(Rectemp.Fields("PriceMode")) = "计划价法" And Qmclcy And Val(Rectemp.Fields("EMoney")) - Val(Rectemp.Fields("PlanMoney")) <> 0 Then
                Rec_Mxz.Fields("DiffAcct") = Xtfhcsfz
            End If
                
            ' 对方科目
            Call DfaccCode(Trim(Rectemp.Fields("InoutClassCode") & ""), Trim(Rectemp.Fields("DeptCode") & ""), Trim(Rectemp.Fields("InvSortcode") & ""), Trim(Rectemp.Fields("MNumber")) & "")
            Rec_Mxz.Fields("DfAcct") = Xtfhcs
            
            Rec_Mxz.UpdateBatch
            
            '收发记录中对应的相应单据，填写记帐标志
            SqlStr = "UPDATE GY_InOutMain SET ChalkitupMan='" & Xtczy & "' WHERE BiLLCode='1201' AND InOutMainId='" & Trim(Rectemp.Fields("InoutMainId")) & "'"
            Cw_DataEnvi.DataConnect.Execute (SqlStr)
            
            '2-生成下月红字回冲单

            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
            
            '年末处理
            If Now_period <> LastMon Then
                Set Rec = Cw_DataEnvi.DataConnect.Execute("SELECT qsrq FROM GY_Kjrlb WHERE Kjyear=" & Xtyear & " and Period=" & Now_period + 1 & "")
                If Not Rec.EOF Then
                   Rec_Mxz.Fields("BillDate") = Trim(Rec.Fields("qsrq"))
                End If
                Rec_Mxz.Fields("ChalkDate") = Rec_Mxz.Fields("BillDate")
                Rec_Mxz.Fields("KjYear") = Xtyear
                Rec_Mxz.Fields("Period") = Now_period + 1
            Else
                Set Rec = Cw_DataEnvi.DataConnect.Execute("SELECT qsrq FROM GY_Kjrlb WHERE Kjyear=" & Xtyear + 1 & " and Period='1'")
                If Not Rec.EOF Then
                   Rec_Mxz.Fields("BillDate") = Trim(Rec.Fields("qsrq"))
                End If
                Rec_Mxz.Fields("ChalkDate") = Rec_Mxz.Fields("BillDate")
                Rec_Mxz.Fields("KjYear") = Xtyear + 1
                Rec_Mxz.Fields("Period") = 1
            End If
            
            '填写物料科目和差异科目
            Xtfhcs = ""
            Xtfhcsfz = ""
            Call MaccCode(Trim(Rectemp.Fields("WhCode") & ""), Trim(Rectemp.Fields("MNumber") & ""), Trim(Rectemp.Fields("InvSortcode")) & "")
            Rec_Mxz.Fields("MateAcct") = Xtfhcs
            
            If Trim(Rectemp.Fields("PriceMode")) = "计划价法" And Qmclcy And Val(Rectemp.Fields("EMoney")) - Val(Rectemp.Fields("PlanMoney")) <> 0 Then
                Rec_Mxz.Fields("DiffAcct") = Xtfhcsfz
            End If
            
            ' 对方科目
            Xtfhcs = ""
            Xtfhcsfz = ""
            Call DfaccCode(Trim(Rectemp.Fields("InoutClassCode") & ""), Trim(Rectemp.Fields("DeptCode") & ""), Trim(Rectemp.Fields("InvSortcode") & ""), Trim(Rectemp.Fields("MNumber")) & "")
            Rec_Mxz.Fields("DfAcct") = Xtfhcs
            
            Rec_Mxz.Fields("BillCode") = "1305"
            
            If Trim(Rectemp.Fields("PurTypeCode") & "") <> "" Then
                Rec_Mxz.Fields("PurTypeCode") = Trim(Rectemp.Fields("PurTypeCode"))
            End If
            If Trim(Rectemp.Fields("WhCode") & "") <> "" Then
                Rec_Mxz.Fields("WhCode") = Trim(Rectemp.Fields("WhCode"))
            End If
            If Trim(Rectemp.Fields("DeptCode") & "") <> "" Then
                Rec_Mxz.Fields("DeptCode") = Trim(Rectemp.Fields("DeptCode"))
            End If
            If Trim(Rectemp.Fields("ReceiptNum") & "") <> "" Then
                Rec_Mxz.Fields("ReceiptNum") = Trim(Rectemp.Fields("ReceiptNum"))
            End If
            If Trim(Rectemp.Fields("PersonCode") & "") <> "" Then
                Rec_Mxz.Fields("PersonCode") = Trim(Rectemp.Fields("PersonCode"))
            End If
            If Trim(Rectemp.Fields("InoutClassCode") & "") <> "" Then
                Rec_Mxz.Fields("InoutClassCode") = Trim(Rectemp.Fields("InoutClassCode"))
            End If
            If Trim(Rectemp.Fields("SupplierCode") & "") <> "" Then
                Rec_Mxz.Fields("SupplierCode") = Trim(Rectemp.Fields("SupplierCode"))
            End If
            If Trim(Rectemp.Fields("MNumber") & "") <> "" Then
                Rec_Mxz.Fields("MNumber") = Trim(Rectemp.Fields("MNumber"))
            End If
            Rec_Mxz.Fields("InQuan") = 0 - Val(Rectemp.Fields("FactReceiptQuan"))
            
            '以计划价法核算按计划价入库 ，以实际价核算的按实际价入库
            If Trim(Rectemp.Fields("PriceMode")) = "计划价法" And Qmclcy Then
                Rec_Mxz.Fields("InPrice") = Val(Rectemp.Fields("PlanPrice"))
                Rec_Mxz.Fields("Inmoney") = 0 - Val(Rectemp.Fields("PlanMoney"))
        
                If Val(Rectemp.Fields("EMoney")) - Val(Rectemp.Fields("PlanMoney")) > 0 Then
                    Rec_Mxz.Fields("dfDiff") = Val(Rectemp.Fields("Emoney")) - Val(Rectemp.Fields("PlanMoney"))
                Else
                    Rec_Mxz.Fields("jfDiff") = Val(Rectemp.Fields("PlanMoney")) - Val(Rectemp.Fields("Emoney"))
                End If
            Else
                Rec_Mxz.Fields("InPrice") = Val(Rectemp.Fields("Price"))
                Rec_Mxz.Fields("InMoney") = 0 - Val(Rectemp.Fields("EMoney"))
            End If
            
            If Trim(Rectemp.Fields("Maker") & "") <> "" Then
                Rec_Mxz.Fields("Maker") = Trim(Rectemp.Fields("Maker"))
            End If
            Rec_Mxz.Fields("checker") = Xtczy
            
            Rec_Mxz.Fields("ChalkitupMan") = Xtczy
            
            If Trim(Rectemp.Fields("Remark") & "") <> "" Then
                Rec_Mxz.Fields("Remark") = Trim(Rectemp.Fields("Remark"))
            End If
            
            Rec_Mxz.UpdateBatch
            
        End If
       
        Rectemp.MoveNext
    Loop
    
    Cw_DataEnvi.DataConnect.CommitTrans
    Djzgcl = True
 
LabelExit:

    Set Rec = Nothing
    Set Rectemp = Nothing
    Set RecTempFz = Nothing
    Set Rec_Mxz = Nothing
    
    Exit Function
    
LabelErr:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Label1.Visible = False
    Djzgcl = False
    Tsxx = "在暂估处理过程中出现未知错误，期末处理失败!"
    Call Xtxxts(Tsxx, 0, 1)
    
End Function

Private Sub Com_Qx_Click()   '取消

   Unload Me
   
End Sub

Private Sub Form_Load()

    '添加仓库
    Call AddWarehouseName
 
    Lbl_labText = CStr(Xtyear) + "." + CStr(PGNowmon)
    SSTab.Tab = 0
      
End Sub

Private Sub AddWarehouseName()        '填充列表框
 
    Dim Rectemp As New ADODB.Recordset
    Dim SqlStr As String
 
    Lst_Cklb(0).Clear
    Lst_Cklb(1).Clear
    
    SqlStr = "SELECT GY_WareHouse.*, GY_whlimit.czybm " & _
             " FROM GY_WareHouse LEFT OUTER JOIN  GY_whlimit ON GY_WareHouse.WhCode = GY_whlimit.WhCode " & _
             " WHERE czybm='" & Xtczybm & "' AND ChhsUseFlag=1 ORDER BY GY_WareHouse.WhCode"
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    
    If Not Rectemp.EOF Then
 
        '限定仓库个数
        ReDim WH_code(Rectemp.RecordCount)
        ReDim Wh_Pricemode(Rectemp.RecordCount)
    
        ReDim WH_codefz(Rectemp.RecordCount)
        ReDim Wh_Pricemodefz(Rectemp.RecordCount)
    
        '添加仓库列表
        For Jsqte = 0 To Rectemp.RecordCount - 1
            If Rectemp.Fields("EndDealFlagChhs") Then
                Lst_Cklb(1).AddItem Trim(Rectemp.Fields("WhName")) + "（" + Trim(Rectemp.Fields("WhCode")) + "）" + " ---- " + Trim(Rectemp.Fields("PriceMode"))
                WH_codefz(Lst_Cklb(1).NewIndex) = Trim(Rectemp.Fields("WhCode"))
                Wh_Pricemodefz(Lst_Cklb(1).NewIndex) = Trim(Rectemp.Fields("PriceMode"))
                Lst_Cklb(1).Selected(Lst_Cklb(1).NewIndex) = True
            Else
                Lst_Cklb(0).AddItem Trim(Rectemp.Fields("WhName")) + "（" + Trim(Rectemp.Fields("WhCode")) + "）" + " ---- " + Trim(Rectemp.Fields("PriceMode"))
                WH_code(Lst_Cklb(0).NewIndex) = Trim(Rectemp.Fields("WhCode"))
                Wh_Pricemode(Lst_Cklb(0).NewIndex) = Trim(Rectemp.Fields("PriceMode"))
                Lst_Cklb(0).Selected(Lst_Cklb(0).NewIndex) = True
            End If
            Rectemp.MoveNext
        Next Jsqte
    
    End If
    
    Set Rectemp = Nothing

End Sub

Private Function Cyljs() As Boolean                                    '差异率计算

    Dim Rectemp As New ADODB.Recordset
    Dim Rec_Query As New ADODB.Recordset               '查询动态集
    Dim Rec_Queryfz As New ADODB.Recordset
    Dim Recmx As New ADODB.Recordset
 
    Dim Qcmoney As Double                              '期初余额
    Dim Qcdiff As Double                               '期初差异
    Dim Byrecmoney As Double                           '本月入库金额
    Dim Bydiff As Double                               '本月差异
    Dim Byoutmoney As Double                           '本月出库调整金额
    Dim Diff_lv As Double                              '差异率
    Dim SqlStr As String
    Dim Now_period As Long
    Dim BillID As Long
    Dim Sort As String
    
    '以下为用户自定义部分[
    Now_period = PGNowmon
    
    Cyljs = False
 
    '差异结转单
    If Rectemp.State = 1 Then Rectemp.Close
    Rectemp.Open "SELECT * FROM Chhs_DiffBill", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockBatchOptimistic
    
    On Error GoTo LabelErr
    
    Cw_DataEnvi.DataConnect.BeginTrans
    
    
    '月初差异 月初金额 本月收入差异   本月收入金额
    SqlStr = Replace(PlanQuery_Cond, "view", "Chhs_Mate", 1, , vbTextCompare)
    SqlStr = "SELECT WhCode,MNumber,StartDiff,StartMoney,JfDiff,DfDiff,Inmoney,OutQuan,OutMoney FROM Chhs_Mate WHERE KjYear='" & PGKjYear & "' and Period='" & Now_period & "' and " + SqlStr + " order by MNumber"
    Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(SqlStr)
    
    Do While Not Rec_Query.EOF
    
        Qcdiff = Rec_Query.Fields("StartDiff")
        Qcmoney = Rec_Query.Fields("StartMoney")
        Bydiff = Rec_Query.Fields("JfDiff") - Rec_Query.Fields("DfDiff")
        Byrecmoney = Rec_Query.Fields("Inmoney")
        Diff_lv = 0
        
        '差异率计算是否包括本期暂估   不包括减掉
        If Not Cylzg Then
            SqlStr = "SELECT JfDiff,DfDiff,InMoney FROM Chhs_List WHERE WhCode='" & Trim(Rec_Query.Fields("WhCode")) & "' " & _
                     " and MNumber='" & Trim(Rec_Query.Fields("MNumber")) & "' " & _
                     " and KjYear='" & PGKjYear & "' and Period='" & Now_period & "' " & _
                     " and (BillCode='1304' or BillCode='1305'or Bill