-

VB开发的ERP系统

  Dim RecTemp As New ADODB.Recordset         '临时使用动态集
  Dim Rec_AccList As New ADODB.Recordset     '应收应付明细帐动态集
  Dim Rec_AccSum As New ADODB.Recordset      '应收应付总帐动态集
  Dim Rec_AccSumAss As New ADODB.Recordset   '应收应付辅助总帐动态集
  Dim Str_PSCode As String                   '往来单位编码
  Dim Str_DeptCode As String                 '部门编码
  Dim Str_PersonCode As String               '职员编码
  Dim Str_ForeignCurrCode As String          '原币编码
  Dim Tsxx As String                         '系统信息提示
  Dim SourceBillCode As String               '形成的应收单的源单据号
  
  Fun_BookSumOtherBill = False
  
  On Error GoTo Swcwcl

  Cw_DataEnvi.DataConnect.BeginTrans
     Cw_DataEnvi.DataConnect.Execute ("Update RP_OtherBill Set Checker='" & Xtczy & "' Where OtherBillID=" & Lng_BillID)
     
     Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select * From RP_OtherBill Where OtherBillID=" & Lng_BillID)
     If RecTemp.EOF Then
        Tsxx = "该单据已被其他人删除!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Function
     End If
     
     SourceBillCode = Trim(RecTemp.Fields("SourceBillCode") & "")
     
     '登记应收/应付明细帐
     
     With Rec_AccList
        If .State = 1 Then .Close
        .Open "Select * From RP_AccList Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        .AddNew
            .Fields("RPFlag") = RecTemp.Fields("RPFlag")                       '应收应付标识
            .Fields("PSCode") = RecTemp.Fields("PSCode")                       '往来单位编码
            .Fields("KJYear") = RecTemp.Fields("KJYear")                       '会计年度
            .Fields("Period") = RecTemp.Fields("Period")                       '会计期间
            .Fields("BillItemCode") = RecTemp.Fields("BillItemCode")           '单据类型
            .Fields("BillID") = RecTemp.Fields("OtherBillID")                  '单据ID
            .Fields("BillCode") = RecTemp.Fields("BillCode")                   '单据编码
            .Fields("BillDate") = RecTemp.Fields("BillDate")                   '单据日期
            .Fields("Digest") = RecTemp.Fields("Digest")                       '摘要
            .Fields("BbYsje") = RecTemp.Fields("BbYsje")                       '应收/应付本币金额
            .Fields("ForeignCurrCode") = RecTemp.Fields("ForeignCurrCode")     '原币编码
            .Fields("AccRate") = RecTemp.Fields("AccRate") + 0                 '记帐汇率
            .Fields("YbYsje") = RecTemp.Fields("YbYsje")                       '原币应收/应付金额
            .Fields("DeptCode") = RecTemp.Fields("DeptCode")                   '原币应收/应付金额
            .Fields("PersonCode") = RecTemp.Fields("PersonCode")               '原币应收/应付金额
            .Fields("AccCode") = RecTemp.Fields("AccCode")                     '其它应收/代垫费用科目
            .Fields("AccCodeArAp") = RecTemp.Fields("AccCodeArAp")             '应收科目
            .Fields("Maker") = RecTemp.Fields("Maker")                         '制单
            .Fields("Checker") = RecTemp.Fields("Checker")                     '审核
            
            '如果是应收票据转出形成的应收单，置.Fields("IfBuildVouch") = True                                                                      '目的是避免在收款单中做凭证
            
            '目的是避免在应收单中重复做凭证
            If SourceBillCode <> "" Then
                .Fields("IfBuildVouch") = True
            End If
        .Update
     End With
     
     '登记应收/应付总帐
     
     Str_PSCode = Trim(RecTemp.Fields("PSCode") & "")
     Str_DeptCode = Trim(RecTemp.Fields("DeptCode") & "")
     Str_PersonCode = Trim(RecTemp.Fields("PersonCode") & "")
     Str_ForeignCurrCode = Trim(RecTemp.Fields("ForeignCurrCode") & "")
     
     With Rec_AccSum
         If .State = 1 Then .Close
        .Open "Select * From RP_AccSum Where RpFlag='" & RecTemp.Fields("RPFlag") & "' And PSCode='" & Str_PSCode & _
        "' And DeptCode='" & Str_DeptCode & "' And PersonCode='" & Str_PersonCode & "' And ForeignCurrCode='" & Str_ForeignCurrCode & "' And kjYear=" & Int_Dqyear & " And Period=" & Int_DqPeriod, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        
        If Not Rec_AccSum.EOF Then
           .Fields("YbYsje") = .Fields("YbYsje") + RecTemp.Fields("YbYsje")                '本期应收/应付原币金额
           .Fields("YbQmye") = .Fields("YbQcye") + .Fields("YbYsje") - .Fields("YbSsje")   '本期期末原币余额
           .Fields("BbYsje") = .Fields("BbYsje") + RecTemp.Fields("BbYsje")                '本期应收/应付本币金额
           .Fields("BbQmye") = .Fields("BbQcye") + .Fields("BbYsje") - .Fields("BbSsje")   '本期期末本币余额
           .Update
        Else
           .AddNew
           .Fields("RPFlag") = RecTemp.Fields("RPFlag")                                           '应收应付标识
           .Fields("PSCode") = Str_PSCode                                                         '往来单位编码
           .Fields("DeptCode") = Str_DeptCode                                                     '部门编码
           .Fields("PersonCode") = Str_PersonCode                                                 '个人编码
           .Fields("ForeignCurrCode") = Str_ForeignCurrCode                                       '原币编码
           .Fields("KJYear") = Int_Dqyear                                                         '会计年度
           .Fields("Period") = Int_DqPeriod                                                       '会计期间
           .Fields("YbYsje") = RecTemp.Fields("YbYsje") + 0                                       '本期应收/应付原币金额
           .Fields("YbQmye") = RecTemp.Fields("YbYsje")                                           '本期期末原币余额
           .Fields("BbYsje") = RecTemp.Fields("BbYsje") + 0                                       '本期应收/应付本币金额
           .Fields("BbQmye") = RecTemp.Fields("BbYsje")                                           '本期期末本币余额
           .Update
    
         End If
    End With
    
  Cw_DataEnvi.DataConnect.CommitTrans
  
  Fun_BookSumOtherBill = True
  
  Exit Function

Swcwcl:
     Cw_DataEnvi.DataConnect.RollbackTrans
     Tsxx = "审核单据过程中出现未知错误,程序自动恢复审核前状态!"
     Call Xtxxts(Tsxx, 0, 1)
     Exit Function
     
End Function

'=======================================应收票据审核======================================'
Public Function Fun_CheckNote(Lng_BillID As Long) As Boolean        '审核应收票据
    Dim RecTemp As New ADODB.Recordset     '临时使用动态集
    Dim Int_Dqyear As Integer              '当前会计年度
    Dim Int_DqPeriod As Integer            '当前会计期间
    Dim Tsxx As String                     '系统信息提示
    
    Fun_CheckNote = False
  
    If Fun_GetAccInformation("AR_IsMakerNotChecker") = 1 Then
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select Maker From RP_Note Where NoteID=" & Lng_BillID & "and Maker='" & Xtczy & "'")
        If Not RecTemp.EOF Then
            Tsxx = "制单审核不能为同一人!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Function
        End If
    End If
  
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select Checker,KjYear,Period  From RP_Note Where NoteID=" & Lng_BillID)
    If Not RecTemp.EOF Then
        If Trim(RecTemp.Fields("Checker") & "") <> "" Then
            Tsxx = "该单据已审核,不需再次审核!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Function
        End If
        Int_Dqyear = RecTemp.Fields("KjYear")
        Int_DqPeriod = RecTemp.Fields("Period")
    End If
  
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select Top 1 Kjyear,Period From Gy_Kjrlb Where ArJzbz=0 Order By Kjyear,Period")
    
    If Not RecTemp.EOF Then
        If Not (Int_Dqyear = RecTemp.Fields("Kjyear") And Int_DqPeriod = RecTemp.Fields("Period")) Then
            Tsxx = "非当前会计期间单据,不能审核过帐!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Function
        End If
    Else
        Tsxx = "非当前会计期间单据,不能审核过帐!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Function
    End If
    
    '审核过帐单据登记到款结算单，应收/应付明细帐和总帐
    If Fun_BookSumNote(Lng_BillID, Int_Dqyear, Int_DqPeriod) Then
        Fun_CheckNote = True
    End If
End Function
Public Function Fun_BookSumNote(Lng_BillID As Long, Int_Dqyear As Integer, Int_DqPeriod) As Boolean '将应收票据写入收款单
    Dim RecTemp As New ADODB.Recordset         '临时使用动态集
    
    Dim Rec_Bill As New ADODB.Recordset        '到款结算单记录集
    Dim CloseBillCode As String                '应收票据对应的结算单编号
    Dim CloseBillId As Integer                 '应收票据对应的结算单ID号
    Dim BillCode As String                     '到款单据代码
    
    Dim Rec_AccList As New ADODB.Recordset     '应收应付明细帐动态集
    Dim Rec_AccSum As New ADODB.Recordset      '应收应付总帐动态集
    Dim Rec_AccSumAss As New ADODB.Recordset   '应收应付辅助总帐动态集
    Dim Str_PSCode As String                   '往来单位编码
    Dim Str_DeptCode As String                 '部门编码
    Dim Str_PersonCode As String               '职员编码
    Dim Str_ForeignCurrCode As String          '原币编码
    Dim Tsxx As String                         '系统信息提示
  
    Fun_BookSumNote = False
    BillCode = "0204"
  
   On Error GoTo Swcwcl

    Cw_DataEnvi.DataConnect.BeginTrans
    Cw_DataEnvi.DataConnect.Execute ("Update RP_Note Set Checker='" & Xtczy & "' Where NoteID=" & Lng_BillID)
     
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select * From RP_Note Where NoteID=" & Lng_BillID)
    If RecTemp.EOF Then
        Tsxx = "该单据已被其他人删除!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Function
    End If
    
     '写收款结算单
    CloseBillCode = CreatBillCode(BillCode, True) '收款单编码
    CloseBillId = CreatBillID(BillCode)           '收款单ID
    
    '将结算单ID写入应收票据中
    Cw_DataEnvi.DataConnect.Execute ("Update RP_Note Set CloseBillId='" & CloseBillId & "' Where NoteID=" & Lng_BillID)

    
    '打开单据表动态集
    If Rec_Bill.State = 1 Then Rec_Bill.Close
    Rec_Bill.Open "Select * From RP_CloseBill Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
    With Rec_Bill
        .AddNew
        .Fields("RPFlag") = RecTemp.Fields("RPFlag")                                                        '应收帐标识
        .Fields("CloseBillId") = CloseBillId                                                                '单据ID
        .Fields("BillItemCode") = "30"                                                                      '收款单
        .Fields("BillCode") = CloseBillCode                                                                 '单据号
        .Fields("BillDate") = RecTemp.Fields("BillDate")                                                    '单据日期
        .Fields("Kjyear") = RecTemp.Fields("KJYear")                                                        '会计年度
        .Fields("Period") = RecTemp.Fields("Period")                                                        '会计期间
        .Fields("PSCode") = RecTemp.Fields("PsCode")                                                        '客户编码
        .Fields("AccCode") = RecTemp.Fields("AccCode")                                                      '结算科目
        .Fields("AccCodeArAp") = RecTemp.Fields("AccCodeArAp")                                              '应收科目
        .Fields("ForeignCurrCode") = RecTemp.Fields("ForeignCurrCode")                                      '原币编码
        .Fields("AccRate") = RecTemp.Fields("AccRate")                                                      '记帐汇率
        .Fields("YbSsJe") = Val(RecTemp.Fields("YbSsJe") & "")                                              '原币金额
        .Fields("BbSsje") = Val(RecTemp.Fields("BbSsJe") & "")                                              '本币金额
        .Fields("DeptCode") = RecTemp.Fields("DeptCode")                                                    '部门
        .Fields("PersonCode") = RecTemp.Fields("PersonCode")                                                '经办人
        .Fields("Digest") = Trim(RecTemp.Fields("Digest")) & "应收票据" & Trim(RecTemp.Fields("NoteCode"))   '摘要
        .Fields("Maker") = RecTemp.Fields("Maker")                                                          '制单人
        .Fields("SourceBillCode") = RecTemp.Fields("NoteCode")                                              '应收票据编码
        .Fields("Checker") = Xtczy                                                                          '审核人
            
        '目的是避免在收款单中重复做凭证
        .Fields("IfBuildVouch") = True
        
        .Update
    End With
    
    '在应收票据中记录该结算单ID
    Cw_DataEnvi.DataConnect.Execute ("Update RP_Note Set CloseBillId='" & CloseBillId & "' Where NoteID=" & Lng_BillID)

     '登记应收/应付明细帐
     
     With Rec_AccList
        If .State = 1 Then .Close
        .Open "Select * From RP_AccList Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        .AddNew
            .Fields("RPFlag") = RecTemp.Fields("RPFlag")                       '应收应付标识