-

VB开发的ERP系统

Attribute VB_Name = "XtsyModule"
'****************************************************************
'*    模 块 名 称 :系统私有模块
'*    功 能 描 述 :系统私有模块用来放置一些子系统独有的过程与函数
'*    程序员姓名  :张建忠
'*    最后修改人  :奚俊峰
'*    最后修改时间:2001/12/30
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'****************************************************************

Public str_Code As String                               '存储列内容参数
'银行对帐公共变量
Public Type Glo_Yhdz
    Unload_TF As Boolean     '窗体是否卸载
    YH_XTXZ  As String       '银行窗体选择
End Type
Public Glo_Variable As Glo_Yhdz     '银行对帐变量
Public Glo_VouchSource As String          '凭证来源，转帐中用的公用变量
Public Glo_FormulaString 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

 '替代用户自定义公式字符串,
 '将用用户输入的函数名替换为SQL中自定义的函数名，及对其隐藏参数进行处理，
 '是否包含未记帐凭证int_Book,现在只有财务函数有此参数选择作用。
 
 Public Function Fn_Replace(SourceStr As String, int_Book As Integer) As String
    
    Dim rs_fn As New ADODB.Recordset
    Dim Sqlstr As String
    Dim i As Integer
    Dim j As Integer
    
    SourceStr = Replace(SourceStr, "本年", Xtyear)
    SourceStr = Replace(SourceStr, "本月", Xtmm)
    
    
    Sqlstr = "select FnAlias, FnName,fnflag from cwzz_UserDefineFn where fnflag>0"
    Set rec_fn = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
    
    With rec_fn
        Do While Not .EOF
            Select Case .Fields("fnflag")
            Case 9
                i = 1
                Do While InStr(i, SourceStr, Trim(.Fields("fnalias"))) <> 0
                    
                    i = InStr(i, SourceStr, Trim(.Fields("fnalias")))
                    j = InStr(i, SourceStr, ")")
                    
                    SourceStr = Mid(SourceStr, 1, j - 1) & "," & CStr(int_Book) & Mid(SourceStr, j, Len(SourceStr) - j + 1)
                    i = j
                Loop
                
            End Select
            .MoveNext
        Loop
    End With
    
    If rec_fn.RecordCount <> 0 Then rec_fn.MoveFirst
    
    With rec_fn
        Do While Not .EOF
            SourceStr = Replace(SourceStr, Trim(.Fields("fnalias")), Trim(.Fields("fnname")))
            .MoveNext
        Loop
    End With
    Fn_Replace = SourceStr
    
End Function

'设置查询统计窗体的标题位置
Public Function SetTitlePos(labObject As Object)
    labObject.Left = 480
    labObject.Top = 240
    labObject.Font.Name = "宋体"
    labObject.Font.Size = 12
    labObject.Font.Bold = True
    labObject.Parent.BackColor = &HFFFFFF
End Function