企业管理

开发平台：
Visual Basic

-：源码内容
							Attribute VB_Name = "XtsyModule"
'系统私有模块用来放置一些子系统独有的过程与函数
Public str_Code As String                               '存储列内容参数
Public FrmString As String
Public GTempDeptCode As String
Public GTempYear As Long
Public GTempDeptName As String
Public GtempInvoiceType As String   '发票窗体名称
Public GtempInvoiceHB As String     '发票是否合并
Dim sjgnbmStr As String                      '上级编码Public XsYear As String             '单据所在会计年
Public XsYear As String               '单据所在会计年
Public XsMm As String               '单据所在会计月
Public GQuotationStatus As String   '报价单关闭状态
Public Xs_IfConsign As Boolean      '是否根据发货单退货
Public Xs_IfInvoice As Boolean      '现销是否根据应收回款开发票
Dim Tsxx As String                  '系统提示信息
Public GTempAnswer As String
Public Sub Drxtztcs()                                   '读入系统帐套参数
   
    Dim Ztcsbrec As New ADODB.Recordset
    Dim RecTemp As New ADODB.Recordset
    Dim Sqlstr As String
  
    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 Xs_AddNew(XsDate As String) As Boolean
Dim Tsxx As String
Dim Sqlstr As String
Dim RecTemp As New ADODB.Recordset
    
    Xs_AddNew = False
    
    Sqlstr = "Select * From Gy_kjrlb where qsrq<='" & Format(XsDate, "yyyy-mm-dd") & "' and zzrq>='" & Format(XsDate, "yyyy-mm-dd") & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If RecTemp.RecordCount > 0 Then
        If Trim(RecTemp.Fields("xsjzbz")) Then
            Tsxx = "当前单据日期所在的会计期间已经结帐!"
            Call Xtxxts(Tsxx, 0, 1)
            Exit Function
        End If
        XsYear = RecTemp.Fields("KjYear")
        XsMm = RecTemp.Fields("Period")
        Xs_AddNew = True
    Else
        Tsxx = "当前单据日期的会计年没有设置!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Function
    End If
    
End Function
Public Function Xs_Dept(Index As Integer, LrText As Object) As Boolean
Dim Tsxx As String
Dim Sqlstr As String
Dim RecTemp As New ADODB.Recordset
Dim RsTemp As New ADODB.Recordset
    
    Xs_Dept = False
    Sqlstr = "select * from gy_department where xsflag='1' and (deptcode='" & LrText & "' or deptname='" & LrText & "')"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    If RecTemp.RecordCount > 0 Then
        Sqlstr = "select * from gy_department where deptcode='" & RecTemp.Fields("ParentCode") & "'"
        Set RsTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
        If RsTemp.RecordCount > 0 Then
            Tsxx = "此部门不是末级部门!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText(Index).SetFocus
            Exit Function
        End If
    Else
        Tsxx = "此部门名称不存在!"
        Call Xtxxts(Tsxx, 0, 1)
        LrText(Index).SetFocus
        Exit Function
    End If
    Xs_Dept = True
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_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 Sub Sub_SysControl()                '读入系统参数设置
    Dim RecTemp As New ADODB.Recordset
    Dim intNum As Integer
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_accinformation where systemcode='Xs'")
    With RecTemp
        Do While Not .EOF
            Select Case Trim(.Fields("itemcode"))
                Case "Xs_IfConsign"
                    Xs_IfConsign = Val(.Fields("itemvalue"))
                Case "Xs_IfInvoice"
                    Xs_IfInvoice = Val(.Fields("itemvalue"))
            End Select
            .MoveNext
        Loop
        .Close
    End With
    Set RecTemp = Nothing
    
End Sub
Public Function Inv_Check(TempId As Integer) As Boolean             '审核发票
    Dim StrTemp As String
    Dim RecTemp As New ADODB.Recordset
    Dim RsTemp As New ADODB.Recordset
    Dim WareCode As String
    Dim OrderId As Integer
    Dim ConsignId As Integer
    Dim Flag As Boolean                 '是否现销
    Dim Quantity As Double              '核销数量
    Dim BackID As Integer               '回款单ID
    Dim BackCode As String              '回款单号
    Dim CreateCode As String            '核销单号
    
    Inv_Check = False
    
    StrTemp = "Select Checker,invoiceflag From Xs_InvoiceBillMain Where InvoiceBillMainID='" & TempId & "'"
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(StrTemp)
    With RecTemp
        If Not .EOF Then
            If Trim(.Fields("Checker") & "") <> "" Then
                Tsxx = "该单据已审核,不能再审核!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
        Else
            Tsxx = "该单据可能被其他用户删除!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Function
        End If
        Flag = Not Trim(.Fields("invoiceflag"))
    End With
    '<<]
    '审核数据判断
    StrTemp = "select * from xs_V_invoiceconsign where InvoiceBillMainID = " & TempId
    Set RsTemp = Cw_DataEnvi.DataConnect.Execute(StrTemp)
    With RsTemp
        Do While Not .EOF
            If Abs(.Fields("RecQuantity")) - Abs(.Fields("InvQuantity")) < Abs(.Fields("Inv_Quantity")) Then
                Tsxx = "该发票中货物 ' " & Trim(.Fields("warename")) & " ' 的开票数量太大!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            .MoveNext
        Loop
    End With
    On Error GoTo ErrTemp
    Cw_DataEnvi.DataConnect.BeginTrans
        '将单据写入审核标识
        Cw_DataEnvi.DataConnect.Execute ("Update Xs_InvoiceBillMain Set Checker='" & Xtczy & "' Where InvoiceBillMainID='" & TempId) & "'"
        '回写发货单、订单
        StrTemp = "select * from Xs_V_InvoiceConsign where InvoiceBillMainID = " & TempId
        Set RsTemp = Cw_DataEnvi.DataConnect.Execute(StrTemp)
        With RsTemp
            If Flag Then            '现销产生回款单
                '回写发货单数据
                Cw_DataEnvi.DataConnect.Execute ("Update Xs_ConsignBillMain Set returnmoneyflag=1 Where ConsignBillMainID='" & TempId & "'")
                Cw_DataEnvi.DataConnect.Execute ("Update Xs_ConsignBillSub Set settleallflag=1,capreturnmoney=capitalwhole Where ConsignBillMainID='" & TempId & "'")
                
                BackID = CreatBillID(1408)
                BackCode = CreatBillCode(1408, True)
                CreateCode = CreatBillCode(1409, True)
                '生成回款单
                If RecTemp.State Then RecTemp.Close
                RecTemp.Open "Select * From Xs_ReturnMoney Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                    RecTemp.AddNew
                    RecTemp.Fields("kjyear") = Xtyear          '会计年
                    RecTemp.Fields("period") = Xtmm            '会计月
                    RecTemp.Fields("ReturnDate") = Format(Xtrq, "yyyy-mm-dd")           '回款日期
                    RecTemp.Fields("ReturnMoneyID") = BackID                          '回款ID
                    RecTemp.Fields("ReturnMoneyCode") = BackCode                        '回款单号
                    RecTemp.Fields("cusCode") = Trim(.Fields("cuscode") & "")           '客户编码
                    RecTemp.Fields("deptCode") = Trim(.Fields("deptcode") & "")         '部门编码
                    RecTemp.Fields("personCode") = Trim(.Fields("personcode") & "")     '职员编码
                    RecTemp.Fields("foreigncurrcode") = Trim(.Fields("foreigncurrcode") & "")   '币种
                    RecTemp.Fields("exchrate") = Trim(.Fields("exchrate") & "")         '汇率
                    RecTemp.Fields("ConVertFlag") = .Fields("ConVertFlag")              '折算方式
                    RecTemp.Fields("CapitalRemainMoney") = 0                            '核销剩余金额（原币）
                    RecTemp.Fields("signdate") = Format(Xtrq, "yyyy-mm-dd")             '签收日期
                    RecTemp.Fields("maker") = Trim(Xtczy & "")                          '制单人
                    RecTemp.Fields("makerdate") = Format(Xtrq, "yyyy-mm-dd")            '制单日期
                    RecTemp.Fields("checker") = Trim(Xtczy & "")                        '审核人
                    RecTemp.Fields("checkerdate") = Format(Xtrq, "yyyy-mm-dd")          '审核日期
                    RecTemp.Update
                    RecTemp.Close
                '回写回款单核销关系
                StrTemp = "select * from Xs_MoneyWare where 1=2"
                RecTemp.Open StrTemp, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                    RecTemp.AddNew
                    RecTemp.Fields("MoneyWareCode") = CreateCode            '标识为同次核销
                    RecTemp.Fields("kjyear") = Xtyear
                    RecTemp.Fields("period") = Xtmm
                    RecTemp.Fields("billtype") = 0
                    RecTemp.Fields("billid") = BackID                         '回款单ID
                    RecTemp.Fields("billcode") = BackCode                       '回款单号
                    RecTemp.Fields("cuscode") = Trim(.Fields("cuscode") & "")   '客户
                    RecTemp.Fields("CapitalUsedMoney") = 0                      '本币核销金额
                    RecTemp.Fields("verifier") = Xtczy
                    RecTemp.Fields("verifierdate") = Format(Xtrq, "yyyy-mm-dd")
                    RecTemp.Update
            End If
            
            Do While Not .EOF
                WareCode = Trim(.Fields("warecode"))
                ConsignId = Trim(.Fields("consignbillmainid"))
                Quantity = Val(.Fields("inv_quantity"))              '核销数量
                '发货单
                If RecTemp.State Then RecTemp.Close
                StrTemp = "select * from xs_consignbillsub where consignbillmainid='" & ConsignId & "' and warecode='" & WareCode & "'"
                RecTemp.Open StrTemp, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                If RecTemp.RecordCount > 0 Then
                    RecTemp.Fields("invquantity") = RecTemp.Fields("invquantity") + Quantity                '开票数量
                    RecTemp.Fields("invoiceMoney") = RecTemp.Fields("invoiceMoney") + Quantity * Val(.Fields("TaxUnitPrice"))          '总金额（原币）
                    RecTemp.Fields("CapInvoiceMoney") = RecTemp.Fields("CapInvoiceMoney") + Quantity * Val(.Fields("capitalTaxUnitPrice"))     '总金额（本币）
                    If Flag Then
                        RecTemp.Fields("ReturnMoney") = RecTemp.Fields("ReturnMoney") + Quantity * Val(.Fields("TaxUnitPrice"))           '回款金额（原币）
                        RecTemp.Fields("CapReturnMoney") = RecTemp.Fields("CapReturnMoney") + Quantity * Val(.Fields("capitalTaxUnitPrice"))  '回款金额（本币）
                        RecTemp.Update
                        RecTemp.Close
                        '回款单
                        Cw_DataEnvi.DataConnect.Execute ("Update Xs_ReturnMoney set ReturnMoney=ReturnMoney+ cast('" & Quantity * Val(.Fields("TaxUnitPrice")) & "' as money),CapitalReturnMoney" & _
                                "=CapitalReturnMoney+ cast( '" & Quantity * Val(.Fields("capitalTaxUnitPrice")) & "' as money) where ReturnMoneyID = '" & BackID & "'")
                        '回款单核销关系
                        Cw_DataEnvi.DataConnect.Execute ("Update Xs_MoneyWare set CapitalUsedMoney=CapitalUsedMoney+ cast( '" & Quantity * Val(.Fields("capitalTaxUnitPrice")) & "' as money) " & _
                                " where billid = '" & BackID & "' and billtype=0")
                        '发货单核销关系
                        StrTemp = "select * from Xs_MoneyWare where 1=2"
                        RecTemp.Open StrTemp, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                            RecTemp.AddNew
                            RecTemp.Fields("MoneyWareCode") = CreateCode        '标识为同次核销
                            RecTemp.Fields("kjyear") = Xtyear
                            RecTemp.Fields("period") = Xtmm
                            RecTemp.Fields("billtype") = 1
                            RecTemp.Fields("billid") = Trim(.Fields("consignbillmainid"))       '发货单ID
                            RecTemp.Fields("billcode") = Trim(.Fields("consigncode"))           '发货单号
                            RecTemp.Fields("cuscode") = Trim(.Fields("cuscode"))                '客户
                            RecTemp.Fields("warecode") = WareCode                               '货物编码
                            RecTemp.Fields("CapitalUsedMoney") = Quantity * Val(.Fields("capitalTaxUnitPrice"))     '本币核销金额
                            RecTemp.Fields("verifier") = Xtczy
                            RecTemp.Fields("verifierdate") = Format(Xtrq, "yyyy-mm-dd")
                    End If
                End If
                RecTemp.Update
                RecTemp.Close
                '订单
                StrTemp = "select orderbillmainid from xs_consignbillmain where ConsignBillMainID = " & ConsignId
                Set RecTemp = Cw_DataEnvi.DataConnect.Execute(StrTemp)
                If RecTemp.RecordCount > 0 Then
                    OrderId = Val(RecTemp.Fields("orderbillmainid") & "")       '取订单号
                    If RecTemp.State Then RecTemp.Close
                    StrTemp = "select * from xs_orderbillsub where orderbillmainid='" & OrderId & "' and warecode='" & WareCode & "'"
                    RecTemp.Open StrTemp, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                    If RecTemp.RecordCount > 0 Then                             '是否有订单
                    RecTemp.Fields("invoicequantity") = RecTemp.Fields("invoicequantity") + Quantity                '开票数量
                    RecTemp.Fields("invoiceMoney") = RecTemp.Fields("invoiceMoney") + Quantity * Val(.Fields("TaxUnitPrice"))          '总金额（原币）
                    RecTemp.Fields("CapInvoiceMoney") = RecTemp.Fields("CapInvoiceMoney") + Quantity * Val(.Fields("capitalTaxUnitPrice"))     '总金额（本币）
                    If Flag Then
                        RecTemp.Fields("ReturnMoney") = RecTemp.Fields("ReturnMoney") + Quantity * Val(.Fields("TaxUnitPrice"))           '回款金额（原币）
                        RecTemp.Fields("CapReturnMoney") = RecTemp.Fields("CapReturnMoney") + Quantity * Val(.Fields("capitalTaxUnitPrice"))  '回款金额（本币）
                    End If
                        RecTemp.Update
                        RecTemp.Close
                    End If
                End If
                .MoveNext
            Loop
        End With
    Cw_DataEnvi.DataConnect.CommitTrans
    
    Inv_Check = True
    Exit Function
    
ErrTemp:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "审核时出错,数据被恢复!"
    Call Xtxxts(Tsxx, 0, 1)
End Function
Public Function Inv_UnCheck(TempId As Integer) As Boolean               '弃审发票
    Dim StrTemp As String
    Dim RecTemp As New ADODB.Recordset
    Dim RsTemp As New ADODB.Recordset
    Dim WareCode As String
    Dim OrderId As Integer
    Dim ConsignId As Integer
    Dim Flag As Boolean                 '是否现销
    Dim Quantity As Double              '核销数量
    Dim BackID As Integer               '回款ID
    Dim BackCode As String              '回款单号
        
    Inv_UnCheck = False
    
    StrTemp = "Select Checker,AccountOpt,ArBookFlag,InvalideMaker,invoiceflag From Xs_InvoiceBillMain Where InvoiceBillMainID=" & TempId
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(StrTemp)
    With RecTemp
        If Not .EOF Then
            If Trim(.Fields("Checker") & "") = "" Then
                Tsxx = "该单据未审核,不允许再弃审!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            If Trim(.Fields("AccountOpt") & "") <> "" Then
                Tsxx = "该单据已经结帐,不允许弃审!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            If Trim(.Fields("ArBookFlag") & "") = 1 Then
                Tsxx = "该单据已被应收系统使用,不允许弃审!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            If Trim(.Fields("InvalideMaker") & "") <> "" Then
                Tsxx = "该单据已被作废,不允许弃审!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
        Else
            Tsxx = "该单据可能被其他用户删除!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Function
        End If
        Flag = Not Trim(.Fields("invoiceflag"))
    End With
    '<<]
   
    On Error GoTo ErrTemp
    Cw_DataEnvi.DataConnect.BeginTrans
        '将单据清除审核标识
        Cw_DataEnvi.DataConnect.Execute ("Update Xs_InvoiceBillMain Set Checker='' Where InvoiceBillMainID='" & TempId) & "'"
        '回写发货单、订单
        StrTemp = "select * from Xs_V_InvoiceConsign where InvoiceBillMainID = " & TempId
        Set RsTemp = Cw_DataEnvi.DataConnect.Execute(StrTemp)
        With RsTemp
            Do While Not .EOF
                WareCode = Trim(.Fields("warecode"))
                ConsignId = Trim(.Fields("consignbillmainid"))
                Quantity = Val(.Fields("inv_quantity"))              '核销数量
                '发货单
                If RecTemp.State Then RecTemp.Close
                StrTemp = "select * from xs_consignbillsub where consignbillmainid='" & ConsignId & "' and warecode='" & WareCode & "'"
                RecTemp.Open StrTemp, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                If RecTemp.RecordCount > 0 Then
                    RecTemp.Fields("invquantity") = RecTemp.Fields("invquantity") - Quantity                '开票数量
                    RecTemp.Fields("invoiceMoney") = RecTemp.Fields("invoiceMoney") - Quantity * Val(.Fields("TaxUnitPrice"))          '总金额（原币）
                    RecTemp.Fields("CapInvoiceMoney") = RecTemp.Fields("CapInvoiceMoney") - Quantity * Val(.Fields("capitalTaxUnitPrice"))      '总金额（本币）
                    If Flag Then
                        RecTemp.Fields("ReturnMoney") = RecTemp.Fields("ReturnMoney") - Quantity * Val(.Fields("TaxUnitPrice"))            '回款金额（原币）
                        RecTemp.Fields("CapReturnMoney") = RecTemp.Fields("CapReturnMoney") - Quantity * Val(.Fields("capitalTaxUnitPrice"))        '回款金额（本币）
                    End If
                End If
                RecTemp.Update
                RecTemp.Close
                '订单
                StrTemp = "select orderbillmainid from xs_consignbillmain where ConsignBillMainID = " & ConsignId
                Set RecTemp = Cw_DataEnvi.DataConnect.Execute(StrTemp)
                If RecTemp.RecordCount > 0 Then
                    OrderId = Val(RecTemp.Fields("orderbillmainid") & "")       '取订单号
                    If RecTemp.State Then RecTemp.Close
                    StrTemp = "select * from xs_orderbillsub where orderbillmainid='" & OrderId & "' and warecode='" & WareCode & "'"
                    RecTemp.Open StrTemp, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                    If RecTemp.RecordCount > 0 Then                             '是否有订单
                    RecTemp.Fields("invoicequantity") = RecTemp.Fields("invoicequantity") - Quantity                '开票数量
                    RecTemp.Fields("invoiceMoney") = RecTemp.Fields("invoiceMoney") - Quantity * Val(.Fields("TaxUnitPrice"))          '总金额（原币）
                    RecTemp.Fields("CapInvoiceMoney") = RecTemp.Fields("CapInvoiceMoney") - Quantity * Val(.Fields("capitalTaxUnitPrice"))     '总金额（本币）
                    If Flag Then
                        RecTemp.Fields("ReturnMoney") = RecTemp.Fields("ReturnMoney") - Quantity * Val(.Fields("TaxUnitPrice"))            '回款金额（原币）
                        RecTemp.Fields("CapReturnMoney") = RecTemp.Fields("CapReturnMoney") - Quantity * Val(.Fields("capitalTaxUnitPrice"))  '回款金额（本币）
                    End If
                        RecTemp.Update
                        RecTemp.Close
                    End If
                End If
                .MoveNext
            Loop
        End With
        '现销回款
        If Flag Then
            Cw_DataEnvi.DataConnect.Execute ("Update Xs_ConsignBillMain Set returnmoneyflag=0 Where ConsignBillMainID='" & TempId & "'")
            Cw_DataEnvi.DataConnect.Execute ("Update Xs_ConsignBillSub Set settleallflag=0,capreturnmoney=0 Where ConsignBillMainID='" & TempId & "'")
            
            Sqlstr = "select * from Xs_V_CM Where Cbillid='" & ConsignId & "'"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If RecTemp.RecordCount > 0 Then
                BackCode = Trim(RecTemp.Fields("MoneyWareCode"))
                BackID = Trim(RecTemp.Fields("Mbillid"))        '回款单ID
            End If
            Cw_DataEnvi.DataConnect.Execute ("delete Xs_ReturnMoney Where ReturnMoneyID='" & BackID & "'")
            Cw_DataEnvi.DataConnect.Execute ("delete Xs_MoneyWare Where MoneyWareCode='" & BackCode & "'")
        End If
    Cw_DataEnvi.DataConnect.CommitTrans
    Inv_UnCheck = True
    Exit Function
ErrTemp:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "弃审时出错,数据被恢复!"
    Call Xtxxts(Tsxx, 0, 1)
End Function
Public Function Inv_Cancel(TempId As Integer) As Boolean               '发票作废
    Dim StrTemp As String
    Dim RecTemp As New ADODB.Recordset
    Dim RsTemp As New ADODB.Recordset
    Dim WareCode As String
    Dim OrderId As Integer
    Dim ConsignId As Integer
    Dim Flag As Boolean                 '是否现销
    Dim Quantity As Double              '核销数量
    Dim BackID As Integer               '回款ID
    Dim BackCode As String              '回款单号
    
    Inv_Cancel = False
    
    StrTemp = "Select Checker,AccountOpt,ArBookFlag,InvalideMaker,invoiceflag From Xs_InvoiceBillMain Where InvoiceBillMainID=" & TempId
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(StrTemp)
    With RecTemp
        If Not .EOF Then
            If Trim(.Fields("Checker") & "") = "" Then
                Tsxx = "该单据未审核,不允许作废!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            If Trim(.Fields("AccountOpt") & "") <> "" Then
                Tsxx = "该单据已经结帐,不允许作废!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            If Trim(.Fields("ArBookFlag") & "") = 1 Then
                Tsxx = "该单据已被应收系统使用,不允许作废!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
            If Trim(.Fields("InvalideMaker") & "") <> "" Then
                Tsxx = "该单据已被作废,不允许再作废!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            End If
        Else
            Tsxx = "该单据可能被其他用户删除!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Function
        End If
        Flag = Not Trim(.Fields("invoiceflag"))
    End With
    '<<]
   
    On Error GoTo ErrTemp
    Cw_DataEnvi.DataConnect.BeginTrans
        '清除作废标识
        Cw_DataEnvi.DataConnect.Execute ("Update Xs_InvoiceBillMain Set InvalideMaker='" & Xtczy & "' Where InvoiceBillMainID='" & TempId) & "'"
        '回写发货单、订单
        StrTemp = "select * from Xs_V_InvoiceConsign where InvoiceBillMainID = " & TempId
        Set RsTemp = Cw_DataEnvi.DataConnect.Execute(StrTemp)
        With RsTemp
            Do While Not .EOF
                WareCode = Trim(.Fields("warecode"))
                ConsignId = Trim(.Fields("consignbillmainid"))
                Quantity = Val(.Fields("inv_quantity"))              '核销数量
                '发货单
                If RecTemp.State Then RecTemp.Close
                StrTemp = "select * from xs_consignbillsub where consignbillmainid='" & ConsignId & "' and warecode='" & WareCode & "'"
                RecTemp.Open StrTemp, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                If RecTemp.RecordCount > 0 Then
                    RecTemp.Fields("invquantity") = RecTemp.Fields("invquantity") - Quantity                '开票数量
                    RecTemp.Fields("invoiceMoney") = RecTemp.Fields("invoiceMoney") - Quantity * Val(.Fields("TaxUnitPrice"))          '总金额（原币）
                    RecTemp.Fields("CapInvoiceMoney") = RecTemp.Fields("CapInvoiceMoney") - Quantity * Val(.Fields("capitalTaxUnitPrice"))      '总金额（本币）
                    If Flag Then
                        RecTemp.Fields("ReturnMoney") = RecTemp.Fields("ReturnMoney") - Quantity * Val(.Fields("TaxUnitPrice"))            '回款金额（原币）
                        RecTemp.Fields("CapReturnMoney") = RecTemp.Fields("CapReturnMoney") - Quantity * Val(.Fields("capitalTaxUnitPrice"))        '回款金额（本币）
                    End If
                End If
                RecTemp.Update
                RecTemp.Close
                '订单
                StrTemp = "select orderbillmainid from xs_consignbillmain where ConsignBillMainID = " & ConsignId
                Set RecTemp = Cw_DataEnvi.DataConnect.Execute(StrTemp)
                If RecTemp.RecordCount > 0 Then
                    OrderId = Val(RecTemp.Fields("orderbillmainid") & "")       '取订单号
                    If RecTemp.State Then RecTemp.Close
                    StrTemp = "select * from xs_orderbillsub where orderbillmainid='" & OrderId & "' and warecode='" & WareCode & "'"
                    RecTemp.Open StrTemp, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
                    If RecTemp.RecordCount > 0 Then                             '是否有订单
                    RecTemp.Fields("invoicequantity") = RecTemp.Fields("invoicequantity") - Quantity                '开票数量
                    RecTemp.Fields("invoiceMoney") = RecTemp.Fields("invoiceMoney") - Quantity * Val(.Fields("TaxUnitPrice"))          '总金额（原币）
                    RecTemp.Fields("CapInvoiceMoney") = RecTemp.Fields("CapInvoiceMoney") - Quantity * Val(.Fields("capitalTaxUnitPrice"))     '总金额（本币）
                    If Flag Then
                        RecTemp.Fields("ReturnMoney") = RecTemp.Fields("ReturnMoney") - Quantity * Val(.Fields("TaxUnitPrice"))            '回款金额（原币）
                        RecTemp.Fields("CapReturnMoney") = RecTemp.Fields("CapReturnMoney") - Quantity * Val(.Fields("capitalTaxUnitPrice"))  '回款金额（本币）
                    End If
                        RecTemp.Update
                        RecTemp.Close
                    End If
                End If
                .MoveNext
            Loop
        End With
        '现销回款
        If Flag Then
            Cw_DataEnvi.DataConnect.Execute ("Update Xs_ConsignBillMain Set returnmoneyflag=0 Where ConsignBillMainID='" & TempId & "'")
            Cw_DataEnvi.DataConnect.Execute ("Update Xs_ConsignBillSub Set settleallflag=0,capreturnmoney=0 Where ConsignBillMainID='" & TempId & "'")
            
            Sqlstr = "select * from Xs_V_CM Where Cbillid='" & ConsignId & "'"
            Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
            If RecTemp.RecordCount > 0 Then
                BackCode = Trim(RecTemp.Fields("MoneyWareCode"))
                BackID = Trim(RecTemp.Fields("Mbillid"))        '回款单ID
            End If
            Cw_DataEnvi.DataConnect.Execute ("delete Xs_ReturnMoney Where ReturnMoneyID='" & BackID & "'")
            Cw_DataEnvi.DataConnect.Execute ("delete Xs_MoneyWare Where MoneyWareCode='" & BackCode & "'")
        End If
    Cw_DataEnvi.DataConnect.CommitTrans
    Inv_Cancel = True                   '作废成功
    Exit Function
ErrTemp:
    Cw_DataEnvi.DataConnect.RollbackTrans
    Tsxx = "作废时出错,数据被恢复!"
    Call Xtxxts(Tsxx, 0, 1)
End Function

						