-

VB开发的ERP系统

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"