-

VB开发的ERP系统

Attribute VB_Name = "XtsyModule"
'系统私有模块用来放置一些子系统独有的过程与函数
Dim Tsxx As String                                      '系统提示信息
Public str_Code As String                               '存储列内容参数
Public str_SQLAutoid As String                          '计划合并生成字符串
Public Int_PlanQueryType As Integer                     '计划执行情况查询类型

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 = S2N(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '数量总位数
        .MoveFirst
        .Find "itemcode='cwslzws'"
        If Not Ztcsbrec.EOF Then
            Xtslzws = S2N(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
   
        '单价总位数
        .MoveFirst
        .Find "itemcode='cwdjzws'"
        If Not Ztcsbrec.EOF Then
            Xtdjzws = S2N(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '金额小数位数
        .MoveFirst
        .Find "itemcode='cwjexsws'"
        If Not Ztcsbrec.EOF Then
            Xtjexsws = S2N(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
   
        '数量小数位数
        .MoveFirst
        .Find "itemcode='cwslxsws'"
        If Not Ztcsbrec.EOF Then
            Xtslxsws = S2N(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        
        '单价小数位数
        .MoveFirst
        .Find "itemcode='cwdjxsws'"
        If Not Ztcsbrec.EOF Then
            Xtdjxsws = S2N(Trim(Ztcsbrec.Fields("itemvalue")))
        End If
        .Close
    End With
  
End Sub
Function RoundToFormat(var_Value, var_Byte) As String
    Dim i As Long
    Dim str_ByteFormat As String
  
    If var_Byte = 0 Then
        str_ByteFormat = ""
    Else
        str_ByteFormat = "."
        For i = 1 To var_Byte
            str_ByteFormat = str_ByteFormat & "0"
        Next i
    End If
    RoundToFormat = Format(var_Value, "##############################" & str_ByteFormat)
  
End Function
Public Function CheckBillDate(LrText As TextBox, KjYear As Integer, Period As Integer) As Boolean
'函数功能：判断用户输入的制单日期是否已经结帐,CheckBillDate为True时，表示已经结帐

    Dim RecTemp As New ADODB.Recordset
    Dim Sqlstr As String
    Dim Tsxx As String
    
    Sqlstr = "Select * FROM  Gy_Kjrlb Where Qsrq<='" & LrText & "' and zzrq>='" & LrText & "' and kjyear=" & Mid(LrText, 1, 4)
    Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With RecTemp
        If Not .EOF Then
            If .Fields("cgjzbz") Then
               CheckBillDate = True
               Tsxx = "所选会计期间已经结帐,不能再填制单据!"
               Call Xtxxts(Tsxx, 0, 1)
               LrText.SetFocus
               Exit Function
            Else
               CheckBillDate = False
               KjYear = S2N(.Fields("kjyear"))
               Period = S2N(.Fields("Period"))
            End If
        Else
            CheckBillDate = True
            Tsxx = "所选年度不正确!"
            Call Xtxxts(Tsxx, 0, 1)
            LrText.SetFocus
            Exit Function
        End If
    End With
    
    RecTemp.Close
    Set RecTemp = Nothing

End Function
Public Function CG_StartAccountCheck(Optional Cancel As Boolean = False) As Boolean  '采购期初结账判断
    Dim rst_Temp As New ADODB.Recordset
    Dim rst_Sqltemp As String
    Dim Tsxx As String
    str_sqlTemp = "SELECT ItemValue From Gy_AccInformation" & _
        " WHERE ltrim(rtrim(SystemCode)) ='Cg' and ltrim(rtrim(ItemCode))='Cg_StartAccount'"
    Set rst_Temp = Cw_DataEnvi.DataConnect.Execute(str_sqlTemp)
    If rst_Temp.RecordCount <> 0 Then
        rst_Temp.MoveFirst
        If Trim("" & rst_Temp.Fields("ItemValue")) = "1" Then
            If Cancel = False Then
                Tsxx = "期初发票已经结帐!"
                Call Xtxxts(Tsxx, 0, 4)
                CG_StartAccountCheck = False
                Exit Function
            End If
        Else
            If Cancel = True Then
                Tsxx = "期初尚未结帐，不能取消期初结帐!"
                Call Xtxxts(Tsxx, 0, 4)
                CG_StartAccountCheck = False
                Exit Function
            End If
        End If
    Else
        Tsxx = "公用信息表中未有发票结帐标识!"
        Call Xtxxts(Tsxx, 0, 4)
        CG_StartAccountCheck = False
        Exit Function
    End If
    CG_StartAccountCheck = True
End Function
Public Function Cg_startCheck(Optional ChalkitupMan As Boolean = False) As Boolean
    Dim rst_Temp As New ADODB.Recordset
    If ChalkitupMan = False Then
        Set rst_Temp = Cw_DataEnvi.DataConnect.Execute("SELECT COUNT(*) AS NUMber From Cg_InvoiceMain WHERE (PeriodStarFlag = 1) AND (LTRIM(RTRIM(ISNULL(Checker, ''))) = '') ")
        If rst_Temp.Fields(0).Value <> 0 Then
            Tsxx = "期初发票未全部审核,不能结账!"
            Call Xtxxts(Tsxx, 0, 4)
            Cg_startCheck = False
            Exit Function
        End If
        rst_Temp.Close
        Set rst_Temp = Nothing
        Cg_startCheck = True
   Else
        Set rst_Temp = Cw_DataEnvi.DataConnect.Execute(" SELECT CgJzbz FROM Gy_kjrlb where BeginFlag=1")
        If rst_Temp.RecordCount <> 0 Then
            If rst_Temp.Fields(0) Then
                Tsxx = "已进行了月末结账,不能取消期初结帐!"
                Call Xtxxts(Tsxx, 0, 4)
                Cg_startCheck = False
                Exit Function
            End If
        End If
        rst_Temp.Close
        Set rst_Temp = Nothing
        Cg_startCheck = True
  End If
End Function
Public Function Bln_IsStartChalk() As Boolean                         '判断系统是否已经期初结帐
    Dim Rec_IsStartChalk As New ADODB.Recordset
    Bln_IsStartChalk = True
    Set Rec_IsStartChalk = Cw_DataEnvi.DataConnect.Execute("Select * from Gy_AccInformation Where " & _
                            " ltrim(rtrim(SystemCode))='Cg' and ltrim(rtrim(ItemCode))='Cg_StartAccount' and ltrim(rtrim(ItemValue))='1'")
    If Rec_IsStartChalk.EOF Then
        
        Bln_IsStartChalk = False
        Exit Function
    End If
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_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_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