企业管理

开发平台：
Visual Basic

-：源码内容
							Attribute VB_Name = "XtsyModule"
'系统私有模块用来放置一些子系统独有的过程与函数
Public TranPara As String       '期初应收票据标识
Public ItemType As String       '单据制作凭证类别
Public Sub Drxtztcs()                                   '读入系统帐套参数
   
    Dim Ztcsbrec As New ADODB.Recordset
    Dim RecTemp As New ADODB.Recordset
    Dim Sqlstr As String
    
    '读入本位币编码及名称
    Sqlstr = "Select ForeignCurrCode,ForeignCurrName from Gy_ForeignCurrency where StandardFlag=1"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    XtSCurrCode = Trim(RecTemp.Fields("ForeignCurrCode"))
    XtSCurrName = Trim(RecTemp.Fields("ForeignCurrName"))
  
    With Ztcsbrec
        '金额总位数
        .Open "Select * From Gy_AccInformation Where SystemCode='Cwzz'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
        .MoveFirst
        .Find "itemcode='cwjezws'"
        If Not Ztcsbrec.EOF Then
            Xtjezws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '数量总位数
        .MoveFirst
        .Find "itemcode='cwslzws'"
        If Not Ztcsbrec.EOF Then
            Xtslzws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
   
        '单价总位数
        .MoveFirst
        .Find "itemcode='cwdjzws'"
        If Not Ztcsbrec.EOF Then
            Xtdjzws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '金额小数位数
        .MoveFirst
        .Find "itemcode='cwjexsws'"
        If Not Ztcsbrec.EOF Then
            Xtjexsws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
   
        '数量小数位数
        .MoveFirst
        .Find "itemcode='cwslxsws'"
        If Not Ztcsbrec.EOF Then
            Xtslxsws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '单价小数位数
        .MoveFirst
        .Find "itemcode='cwdjxsws'"
        If Not Ztcsbrec.EOF Then
            Xtdjxsws = Val(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        .Close
    End With
  
End Sub
Public Function Fun_GetAccInformation(Str_ItemCode As String) As Variant                 '按输入项目读入系统帐套参数值
    
    Dim RecTemp As New ADODB.Recordset      '临时使用动态集
    Dim Sqlstr As String                    '连接字符串
    
    Sqlstr = "Select DataType,ItemValue From Gy_AccInformation Where ItemCode='" & Str_ItemCode & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
    
        If Not .EOF Then
            Select Case .Fields("DataType")
                Case 0
                    Fun_GetAccInformation = Trim(.Fields("ItemValue"))
                Case 1, 2
                    Fun_GetAccInformation = Val(.Fields("ItemValue"))
                Case 3
                    Fun_GetAccInformation = Format(.Fields("ItemValue"), "yyyy-mm-dd")
            End Select
        End If
    End With
End Function
Public Function Fun_GetInputCode(ParaItem As String) As String                                                      '读取应收应付系统基本科目
    'ParaItem 是系统传递来的项目参数
    
    Dim RecTemp As New ADODB.Recordset
    
    Sqlstr = "SELECT Ccode From Rp_InputCode Where ItemCode='" & ParaItem & "'"
            
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    If Not RecTemp.EOF Then
        Fun_GetInputCode = Trim(RecTemp.Fields("Ccode") & "")
    Else
        Fun_GetInputCode = ""
    End If
End Function
Public Function Fun_InputCodeCustomer(ParaCus As String, Optional ArPr As Integer) As String                        '读取客户对应应收、预收科目
    
    'ParaCus 客户编码或客户名称   ArPr:0-默认应收科目 1-预收科目
    
    Dim RecTemp As New ADODB.Recordset      '临时使用动态集
    Dim Sqlstr As String                    '连接字符串
    
    Fun_InputCodeCustomer = ""
    
    Sqlstr = "SELECT ArAccCode,PrAccCode FROM Gy_Customer Where CusCode='" & ParaCus & "' OR CusName='" & ParaCus & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    If Not RecTemp.EOF Then
        Select Case ArPr
            Case 0
                If Trim(RecTemp.Fields("ArAccCode") & "") <> "" Then
                    Fun_InputCodeCustomer = Trim(RecTemp.Fields("ArAccCode") & "")
                Else
                    Fun_InputCodeCustomer = Fun_GetInputCode("AR_ArAccCode")
                End If
            Case 1
                If Trim(RecTemp.Fields("PrAccCode") & "") <> "" Then
                    Fun_InputCodeCustomer = Trim(RecTemp.Fields("PrAccCode") & "")
                Else
                    Fun_InputCodeCustomer = Fun_GetInputCode("AR_PrAccCode")
                End If
        End Select
    End If
    
End Function
Public Function Fun_InputCodeSupplier(ParaSup As String, Optional ArPr As Integer) As String                        '读取供应商对应应付、预付科目
    
    'ParaCus 供应商编码或供应商名称   ArPr:0-默认应付科目 1-预付科目
    
    Dim RecTemp As New ADODB.Recordset      '临时使用动态集
    Dim Sqlstr As String                    '连接字符串
    
    Fun_InputCodeSupplier = ""
    
    Sqlstr = "SELECT ApAccCode,PpAccCode FROM Gy_Supplier Where SupplierCode='" & ParaSup & "' OR SupplierName='" & ParaSup & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    If Not RecTemp.EOF Then
        Select Case ArPr
            Case 0
                If Trim(RecTemp.Fields("ApAccCode") & "") <> "" Then
                    Fun_InputCodeSupplier = Trim(RecTemp.Fields("ApAccCode") & "")
                Else
                    Fun_InputCodeSupplier = Fun_GetInputCode("AP_ApAccCode")
                End If
            Case 1
                If Trim(RecTemp.Fields("PpAccCode") & "") <> "" Then
                    Fun_InputCodeSupplier = Trim(RecTemp.Fields("PpAccCode") & "")
                Else
                    Fun_InputCodeSupplier = Fun_GetInputCode("AP_PpAccCode")
                End If
        End Select
    End If
    
End Function
Public Function Fun_InputCodeSellTax(MaterialCode As String, Optional SellTax As Integer) As String           '读取存货对应销售收入和应交增值税科目
    
    'MaterialCode 存货编码  SellTax:0-默认销售收入科目 1-应交增值税科目
    
    Dim RecTemp As New ADODB.Recordset      '临时使用动态集
    Dim Sqlstr As String                    '连接字符串
    
    Fun_InputCodeSellTax = ""
    
    Sqlstr = "SELECT SellAccCode,SellTaxAccCode FROM Gy_Material Where MNumber='" & MaterialCode & "' OR Mname='" & MaterialCode & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    If Not RecTemp.EOF Then
        Select Case SellTax
            Case 0
                If Trim(RecTemp.Fields("SellAccCode") & "") <> "" Then
                    Fun_InputCodeSellTax = Trim(RecTemp.Fields("SellAccCode") & "")
                Else
                    Fun_InputCodeSellTax = Fun_GetInputCode("AR_SellAccCode")
                End If
            Case 1
                If Trim(RecTemp.Fields("SellTaxAccCode") & "") <> "" Then
                    Fun_InputCodeSellTax = Trim(RecTemp.Fields("SellTaxAccCode") & "")
                Else
                    Fun_InputCodeSellTax = Fun_GetInputCode("AR_SellTaxAccCode")
                End If
        End Select
    End If
    
End Function
Public Function Fun_InputCodePurTax(MaterialCode As String, Optional PurTax As Integer) As String           '读取存货对应采购和采购税金科目
    
    'MaterialCode 存货编码  PurTax:0-默认采购科目 1-采购税金科目
    
    Dim RecTemp As New ADODB.Recordset      '临时使用动态集
    Dim Sqlstr As String                    '连接字符串
    
    Fun_InputCodePurTax = ""
    
    Sqlstr = "SELECT PurAccCode,PurTaxAccCode FROM Gy_Material Where MNumber='" & MaterialCode & "' OR Mname='" & MaterialCode & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    If Not RecTemp.EOF Then
        Select Case PurTax
            Case 0
                If Trim(RecTemp.Fields("PurAccCode") & "") <> "" Then
                    Fun_InputCodePurTax = Trim(RecTemp.Fields("PurAccCode") & "")
                Else
                    Fun_InputCodePurTax = Fun_GetInputCode("AP_PurAccCode")
                End If
            Case 1
                If Trim(RecTemp.Fields("PurTaxAccCode") & "") <> "" Then
                    Fun_InputCodePurTax = Trim(RecTemp.Fields("PurTaxAccCode") & "")
                Else
                    Fun_InputCodePurTax = Fun_GetInputCode("AP_PurTaxAccCode")
                End If
        End Select
    End If
    
End Function
Public Sub Sub_GetAccRate(ParaForeignCurr As String, Bln_ConVertFlag As Boolean, Dbl_AccRate As Double)     '取外币记帐汇率
    
    'ParaForeignCurr 外币编码或外币名称  Bln_ConVertFlag:返回外币折算方式   Dbl_AccRate:返回外币记帐汇率
    
    Dim RecTemp As New ADODB.Recordset      '临时使用动态集
    Dim Sqlstr As String                    '连接字符串
    
    Sqlstr = "SELECT ConVertFlag,AccRate FROM Gy_ForeignCurrency Where ForeignCurrCode='" & ParaForeignCurr & "' OR ForeignCurrName='" & ParaForeignCurr & "'"
    
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    If Not RecTemp.EOF Then
       Bln_ConVertFlag = RecTemp.Fields("ConVertFlag")
       Dbl_AccRate = RecTemp.Fields("AccRate")
    End If
    
End Sub
Public Function Fun_GetPeriod(ParaBillDate As String, Kjyear As Integer, Period As Integer) As Boolean                 '判断单据日期是否有效,如有效则返回其所在年度和会计期间
    'ParaBillDate:单据日期 Kjyear:返回会计年度 Period:返回会计期间
    
    Dim RecTemp As New ADODB.Recordset      '临时使用动态集
    Dim Sqlstr As String                    '连接字符串
    Dim Tsxx As String                      '系统信息提示
    
    Fun_GetPeriod = False
    
    Sqlstr = "SELECT Kjyear,Period,ApJzbz FROM Gy_Kjrlb Where Qsrq<='" & ParaBillDate & "' And Zzrq>='" & ParaBillDate & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
        If .EOF Then
           Tsxx = "单据日期不在当前所选择年度会计期间内!"
           Call Xtxxts(Tsxx, 0, 4)
           Exit Function
        Else
            If .Fields("Kjyear") <> Xtyear Then
                Tsxx = "单据日期不在当前所选择年度会计期间内!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            If RecTemp.Fields("ApJzbz") Then
                Tsxx = "单据日期所在会计期间已结帐!"
                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("Ap_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 ApJzbz=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                         '系统信息提示
  
  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
     
     '登记应收/应付明细帐
     
     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"))               '审核人
        
        .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("Ap_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 ApJzbz=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     '审核过帐单据登记应收/应付明细帐和总帐
  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                         '系统信息提示
  
  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
     
     '登记应收/应付明细帐
     
     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")                     '审核
        .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("Ap_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 ApJzbz=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                         '系统信息提示
  
    '10-将应付票据写入付款单
    Fun_BookSumNote = False
    BillCode = "0304"
  
    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
     
     '计算付款结算单编码和ID
    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") = "90"                                                                      '付款单
        .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") = RecTemp.Fields("YbSsJe")                                                        '原币金额
        .Fields("BbSsje") = 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
    
     '20-登记应收/应付明细帐
     
     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") = "90"                                     '单据类型
            .Fields("BillID") = CloseBillId                                    '单据ID
            .Fields("BillCode") = CloseBillCode                                '单据编码
            .Fields("BillDate") = RecTemp.Fields("BillDate")                   '单据日期
            .Fields("Digest") = Trim(RecTemp.Fields("Digest")) & "应付票据" & Trim(RecTemp.Fields("NoteCode")) '摘要
            .Fields("BbSsje") = RecTemp.Fields("BbSsJe")                       '收回/付款本币金额
            .Fields("ForeignCurrCode") = RecTemp.Fields("ForeignCurrCode")     '原币编码
            .Fields("AccRate") = RecTemp.Fields("AccRate") + 0                 '记帐汇率
            .Fields("YbSsje") = RecTemp.Fields("YbSsJe")                       '原币收回/付款金额
            .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                                     '在不必在明细帐中做凭证
        .Update
     End With
     
     '30-登记应收/应付总帐
     
     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") = RecTemp.Fields("KJYear")                                           '会计年度
           .Fields("Period") = RecTemp.Fields("Period")                                           '会计期间
           .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_BookSumNote = True
  
  Exit Function
Swcwcl:
     Cw_DataEnvi.DataConnect.RollbackTrans
     Tsxx = "审核单据过程中出现未知错误,程序自动恢复审核前状态!"
     Call Xtxxts(Tsxx, 0, 1)
     Exit Function
End Function
'=======================================采购发票过帐======================================'
Public Function Fun_AccInvoiceBill(Lng_BillID As Long, Int_Dqyear, Int_DqPeriod) As Boolean      '采购发票过帐
  Dim RecTemp As New ADODB.Recordset         '临时使用动态集
  Dim Rec_AccList As New ADODB.Recordset     '应收应付明细帐动态集
  Dim Rec_AccSum 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_AccInvoiceBill = False
  
  On Error GoTo Swcwcl
  Cw_DataEnvi.DataConnect.BeginTrans
  
     Set RecTemp = Cw_DataEnvi.DataConnect.Execute("Select * From Cg_InvoiceMain Where ApBookFlag=0 And Checker<>'' And InvoiceMainID=" & Lng_BillID)
     If RecTemp.EOF Then
        Fun_AccInvoiceBill = True
        Cw_DataEnvi.DataConnect.RollbackTrans
        Exit Function
     End If
     
     '对采购发票写过帐标识
     Cw_DataEnvi.DataConnect.Execute ("Update Cg_InvoiceMain Set ApBookFlag=1 Where InvoiceMainID=" & 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") = "AP"                                           '应收应付标识
            .Fields("PSCode") = RecTemp.Fields("SupplierCode")                 '往来单位编码
            .Fields("KJYear") = Int_Dqyear                                     '过帐会计年度
            .Fields("Period") = Int_DqPeriod                                   '过帐会计期间
            If RecTemp.Fields("InvoiceSort") = "0" Then
               .Fields("BillItemCode") = "70"                                  '单据类型(采购普通发票)
            Else
               .Fields("BillItemCode") = "71"                                  '单据类型(采购专用发票)
            End If
            .Fields("BillID") = RecTemp.Fields("InvoiceMainID")                '单据ID
            .Fields("BillCode") = RecTemp.Fields("InvoiceNum")                 '单据编码
            .Fields("BillDate") = Xtrq                                         '单据日期(过帐日期)
            .Fields("Digest") = RecTemp.Fields("Remark")                       '摘要
            .Fields("BbYsje") = RecTemp.Fields("NowValue")                     '应收/应付本币金额
            .Fields("ForeignCurrCode") = RecTemp.Fields("ForeignCurrCode")     '原币编码
            .Fields("AccRate") = RecTemp.Fields("AccRate") + 0                 '记帐汇率
            .Fields("YbYsje") = RecTemp.Fields("NowValueFor")                  '原币应收/应付金额
            .Fields("DeptCode") = Trim(RecTemp.Fields("DeptCode") & "")        '部门
            .Fields("PersonCode") = Trim(RecTemp.Fields("PersonCode") & "")    '业务员
            .Fields("AccCodeArAp") = RecTemp.Fields("ApAccCode")               '应付科目
            .Fields("Maker") = RecTemp.Fields("Maker")                         '制单
            .Fields("Checker") = RecTemp.Fields("Checker")                     '审核
        
        .Update
     End With
     
     '登记应收/应付总帐
     
     Str_PSCode = Trim(RecTemp.Fields("SupplierCode") & "")
     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='AP' 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("NowValueFor")                  '本期应收/应付原币金额
           .Fields("YbQmye") = .Fields("YbQcye") + .Fields("YbYsje") - .Fields("YbSsje")          '本期期末原币余额
           .Fields("BbYsje") = .Fields("BbYsje") + RecTemp.Fields("NowValue")                     '本期应收/应付本币金额
           .Fields("BbQmye") = .Fields("BbQcye") + .Fields("BbYsje") - .Fields("BbSsje")          '本期期末本币余额
           .Update
        Else
           .AddNew
           .Fields("RPFlag") = "AP"                                                               '应收应付标识
           .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("NowValueFor") + 0                                  '本期应收/应付原币金额
           .Fields("YbQmye") = RecTemp.Fields("NowValueFor")                                      '本期期末原币余额
           .Fields("BbYsje") = RecTemp.Fields("NowValue") + 0                                     '本期应收/应付本币金额
           .Fields("BbQmye") = RecTemp.Fields("NowValue")                                         '本期期末本币余额
           .Update
    
         End If
     End With
    
  Cw_DataEnvi.DataConnect.CommitTrans
  
  Fun_AccInvoiceBill = True
  
  Exit Function
Swcwcl:
     Cw_DataEnvi.DataConnect.RollbackTrans
     Tsxx = "发票过帐过程中出现未知错误,程序自动恢复过帐前状态!"
     Call Xtxxts(Tsxx, 0, 1)
     Exit Function
  
End Function
Public Function AddImageCombo(Combote As ImageCombo, AddKey As String, AddText As String) '补充填充列表框(ImageCombo)
  '函数参数：列表框(ImageCombo)，填充索引(AddKey),填充内容(AddText)
  Dim ci As ComboItem
  
  Set ci = Combote.ComboItems.Add(, AddKey, AddText)
  
End Function
'***********************应付帐款会计科目*********************
Public Function Fun_ApKjKm(KmType As String) As String               '读取应付帐款科目
    
    'KmType 应付帐款对应的编码
    Dim RecTemp As New ADODB.Recordset              '临时查询动态集
    Dim StrTemp As String                           '连接字符串
    
    StrTemp = " Select CCode From RP_InputCode Where ItemCode='" & KmType & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(StrTemp)
    With RecTemp
        If Not .EOF Then
            Fun_ApKjKm = Trim(.Fields("CCode"))
        Else
            Fun_ApKjKm = ""
        End If
    End With
End Function

						