-

VB开发的ERP系统

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 & "'"