-

VB开发的ERP系统

                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            
            Kjyear = .Fields("Kjyear")              '返回会计年度
            Period = .Fields("Period")              '返回会计期间
            
        End If
    End With
    
    Fun_GetPeriod = True
            
End Function
Public Function GetBankCcode(ParaItem As String) As String     '根据银行代码取对应银行科目
    'ParaItem 是系统传递来的项目参数
    Dim RecTemp As New ADODB.Recordset
    
    Sqlstr = "SELECT dbo.Gy_BankAccount.AccCode AS Ccode, dbo.Cwzz_AccCode.Cname " & _
             "   FROM dbo.Cwzz_AccCode INNER JOIN " & _
            " dbo.Gy_BankAccount ON dbo.Cwzz_AccCode.Ccode = dbo.Gy_BankAccount.AccCode " & _
            "Where BankCode='" & ParaItem & "'"
            
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If RecTemp.EOF = False Then
       GetBankCcode = Trim(RecTemp.Fields("Ccode"))
    Else
        GetBankCcode = ""
    End If
End Function

'=======================================结算单审核======================================'
Public Function Fun_CheckCloseBill(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_CheckCloseBill = False
  
    If Fun_GetAccInformation("AR_IsMakerNotChecker") = 1 Then
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select Maker From RP_CloseBill Where CloseBillID=" & 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_CloseBill Where CloseBillID=" & 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_BookSumCloseBill(Lng_BillID, Int_Dqyear, Int_DqPeriod) Then
        Fun_CheckCloseBill = True
    End If
  
End Function
Private Function Fun_BookSumCloseBill(Lng_BillID As Long, Int_Dqyear As Integer, Int_DqPeriod As Integer) As Boolean     '审核过帐单据登记应收/应付明细帐和总帐
  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_BookSumCloseBill = False
  
  On Error GoTo Swcwcl

  Cw_DataEnvi.DataConnect.BeginTrans
     Cw_DataEnvi.DataConnect.Execute ("Update RP_CloseBill Set Checker='" & Xtczy & "' Where CloseBillID=" & Lng_BillID)
     
     Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select * From RP_CloseBill Where CloseBillID=" & 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("CloseBillID")                  '单据ID
            .Fields("BillCode") = RecTemp.Fields("BillCode")                   '单据编码
            .Fields("BillDate") = RecTemp.Fields("BillDate")                   '单据日期
            .Fields("BbSsje") = RecTemp.Fields("BbSsje")                       '收回/付款本币金额
            .Fields("ForeignCurrCode") = RecTemp.Fields("ForeignCurrCode")     '原币编码
            .Fields("AccRate") = RecTemp.Fields("AccRate") + 0                 '记帐汇率
            .Fields("YbSsje") = RecTemp.Fields("YbSsje")                       '原币收回/付款金额
            .Fields("SSCode") = RecTemp.Fields("SSCode")                       '结算方式
            .Fields("BankBillNo") = RecTemp.Fields("BankBillNo")               '银行票据号码
            .Fields("AccCode") = RecTemp.Fields("AccCode")                     '单据科目编码
            .Fields("AccCodeArAp") = RecTemp.Fields("AccCodeArAp")             '应收科目编码
            .Fields("DeptCode") = RecTemp.Fields("DeptCode")                   '部门
            .Fields("PersonCode") = RecTemp.Fields("PersonCode")               '经办人
            .Fields("BankCode") = RecTemp.Fields("BankCode")                   '银行帐户
            .Fields("Digest") = Trim(RecTemp.Fields("Digest"))                 '摘要
            .Fields("Maker") = Trim(RecTemp.Fields("Maker"))                   '制单人
            .Fields("Checker") = Trim(RecTemp.Fields("Checker"))               '审核人
            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='" & Trim(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("YbSsje") = .Fields("YbSsje") + RecTemp.Fields("YbSsje")                       '本期收回/付款原币金额
           .Fields("YbQmye") = .Fields("YbQcye") + .Fields("YbYsje") - .Fields("YbSsje")          '本期期末原币余额
           .Fields("BbSsje") = .Fields("BbSsje") + RecTemp.Fields("BbSsje")                       '本期收回/付款本币金额
           .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("YbSsje") = RecTemp.Fields("YbSsje") + 0                                       '本期收回/付款原币金额
           .Fields("YbQmye") = -RecTemp.Fields("YbSsje")                                          '本期期末原币余额
           .Fields("BbSsje") = RecTemp.Fields("BbSsje") + 0                                       '本期收回/付款本币金额
           .Fields("BbQmye") = -RecTemp.Fields("BbSsje")                                          '本期期末本币余额
           .Update
    
         End If
    End With
    
  Cw_DataEnvi.DataConnect.CommitTrans
  
  Fun_BookSumCloseBill = True
  
  Exit Function

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


'======================================其它应收单(代垫费用单)审核==================================='
Public Function Fun_CheckOtherBill(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_CheckOtherBill = False
    
    '判断制单审核是否不能为同一人
    If Fun_GetAccInformation("AR_IsMakerNotChecker") = 1 Then
        Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select Maker From RP_OtherBill Where OtherBillID=" & 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_OtherBill Where OtherBillID=" & 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_BookSumOtherBill(Lng_BillID, Int_Dqyear, Int_DqPeriod) Then
        Fun_CheckOtherBill = True
    End If
  
End Function
Private Function Fun_BookSumOtherBill(Lng_BillID As Long, Int_Dqyear As Integer, Int_DqPeriod As Integer) As Boolean     '审核过帐单据登记应收/应付明细帐和总帐