-

VB开发的ERP系统

Attribute VB_Name = "XtsyModule"
'系统私有模块用来放置一些子系统独有的过程与函数

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 CZ_CenterCode As String                          '成本中心参照
Public Glo_NonceCenter As String                        '当前成本中心
Public Glo_NonceItem As String                          '当前成本项目
Public Glo_Year As Integer
Public Glo_Period As Integer
Type Glo_ObjectId
    ONum() As String
    OId() As String
End Type
Public Glo_ObjectId1 As Glo_ObjectId

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 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 Sub fill_tv(tv As TreeView, flbm As ADODB.Recordset, field1 As String, field2 As String, field3 As String, bmjc_bz As Boolean, tree_name As String, Treeprant As String, Treechr As String)
'---------------------------------------------
'填充TREEVIEW
Dim fllb, lsbl(), lsbl1(), remlayer, nodX, tem, count
   On Error GoTo ERRORCL
    tv.Nodes.Clear
    flbm.Requery
    If flbm.EOF Then
        Set nodX = tv.Nodes.Add(, 4, "r", tree_name, Treeprant)
        Exit Sub
    Else
        Set nodX = tv.Nodes.Add(, 4, "r", tree_name, Treeprant)
    End If
    flbm.MoveFirst
    count = 1
    If bmjc_bz Then
        Do While Not flbm.EOF
             fllb = "(" + Trim(flbm.Fields(field1)) + ")" + Trim(flbm.Fields(field2))
             remlayer = flbm.Fields("code_level")
             tem = Trim(flbm.Fields(field3))
             Select Case remlayer
               Case 1
                  ReDim Preserve lsbl(remlayer)
                  ReDim Preserve lsbl1(remlayer)
                  lsbl(remlayer) = "p" & tem
                  Set nodX = tv.Nodes.Add("r", 4, lsbl(remlayer), fllb, Treechr)
                  tv.Nodes(count).Expanded = True
               Case 2
                   ReDim Preserve lsbl1(remlayer)
                   ReDim Preserve lsbl1(remlayer)
                  lsbl1(remlayer) = "p" & tem
                  Set nodX = tv.Nodes.Add(lsbl(remlayer - 1), tvwChild, lsbl1(remlayer), fllb, Treechr)
               Case 3
                   ReDim Preserve lsbl(remlayer)
                   ReDim Preserve lsbl1(remlayer)
                  lsbl(remlayer) = lsbl1(remlayer - 1)
                  lsbl1(remlayer) = "p" & tem
                  Set nodX = tv.Nodes.Add(lsbl(remlayer), tvwChild, lsbl1(remlayer), fllb, Treechr)
               Case Else
                   ReDim Preserve lsbl(remlayer)
                   ReDim Preserve lsbl1(remlayer)
                  lsbl(remlayer) = lsbl1(remlayer - 1)
                  lsbl1(remlayer) = "p" & tem
                  Set nodX = tv.Nodes.Add(lsbl(remlayer), tvwChild, lsbl1(remlayer), fllb, Treechr)
               End Select
              count = count + 1
              flbm.MoveNext
        Loop
    Else
        Do While Not flbm.EOF
            fllb = "(" + Trim(flbm.Fields(field1)) + ")" + Trim(flbm.Fields(field2))
            tem = Trim(flbm.Fields("flbm"))
            lsbl(remlayer) = "p" & tem
            Set nodX = tv.Nodes.Add(, 4, lsbl(remlayer), fllb)
            flbm.MoveNext
        Loop
    End If
    Exit Sub
ERRORCL:
    MsgBox "程序出现错误", vbExclamation, Title_Bar
    Exit Sub
End Sub