-

VB开发的ERP系统

Attribute VB_Name = "XtsyModule"
'*********************************************************************
'*    模 块 名 称 :财务分析私有模块
'*    功 能 描 述 :
'*    程序员姓名  :魏永生
'*    最后修改人  :
'*    最后修改时间:2002/1/21
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'*
'*********************************************************************

'系统私有模块用来放置一些子系统独有的过程与函数
Public str_Code As String                               '存储列内容参数

'/*
'-------------------bsj-------------------------------------
Public Const DEBUG_FLAG = False '  调试标志，发布时设为false

Public Type TAG_TYPE
    strType As String '指标类别
    strName As String '指标名称
    strUnit As String '单位
    sigCurrentV As Double '本期实际数据
    sigYearBeginV As Double '本年年初数据
    strTagAdd1 As String '指标增减
    strCompDate As String '比较期间
    sigComPareV As Single '比较期数据
    strTagAdd2 As String '指标增减
End Type

Public TagArry() As TAG_TYPE  '自定义数组

Public Type PRO_TYPE
    strName As String '产品名称
    sigComeIn As Double '销售收入
    sigCost As Double '销售成本
    sigMaoLi As Double '销售毛利
    sigMaoLiLv As Double '销售毛利率
End Type

Public ProArry() As PRO_TYPE  '自定义数组（产品毛利分析）

Public Type ITE_TYPE
    strItemClass As String '项目大类
    strItemName As String '项目名称
    lngInCome As Double '项目收入
    lngCost As Double ' 项目成本
    lngMaoLi As Double '项目毛利
    lngMaoLiLv As Double '项目毛利率
End Type

Public IteArry() As ITE_TYPE  '自定义数组（项目毛利分析）
Public mySeachForm As New Bbfx_SelDate
'----------------------------------------------------------
Public g_code As String             '传递单据号
Public g_status As String           '传递单据状态
Public g_help_infor() As String     '用以返回帮助窗体的信息
Public m, n As Long                 '公用计数器
Public StrString As String

'在预算设置中使用
Public Str_DeptCode                                '预算部门代码
Public Str_DeptName                                '预算部门名称
Public Str_ItemCode                                '项目代码
Public Str_ItemName                                '项目名称
Public Str_ItemClassCode                           '项目类别代码
Public Str_ItemClassName                           '项目类别名称


Public Str_Ccode As String                         '预算科目
Public Int_OriYear As Integer                      '条件选择的会计年度
Public Int_Month As Integer                        '月份
Public Str_Show As String                          '追加金额提示信息
Public Str_TableAdd As String                      '追加金额表名
Public Cur_TableAdd As Currency                    '追加金额表合计值回写主表单元格
Public Int_I_Id As Integer                         '主表记录标识，供从表使用
Public Str_Title As String                         '从表标题
Public Str_ReportSubTitle As String                '从表子标题

Public Frm_AnalysisC As Form                       '预算分析查询条件窗体
Public Frm_AnalysisA As Form                       '预算分析查询结果窗体

'Public Str_ReportSubTitle As String               '预算分析表子标题，使用上面定义的变量
'Public Str_Title As String                        '预算分析表主标题，使用上面定义的变量
Public str_BudgetProc As String                    '预算分析存贮过程字串
Public str_AnalysisProc As String                  '预算分析存贮过程字串
Public bln_FrmBudgetA As Boolean                   '代表窗体是否已经存在






Public Function FnBln_RefreshArray(int_StartCol As Long, int_FinishCol As Long, GridStr() As String, GridInf()) As Boolean
    '功能：实现网格的列移动
    '说明：本函数是在模式工程的基础上创建的，请确认你的窗体中的网格是通过
    '     BzWgcsh(CxbbGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr()) 函数来定义的
    '参数：int_StartCol——网格开始移动列
    '参数：int_FinishCol——网格移动结束列
    '参数：GridStr()——网格的信息数组
    '思路：对于要移动的网格来说，所有的信息都保存在几个系统数组中，其中GridStr（）数组保存着逻辑定位和
    '       物理定位之间的转换关系，使我们可以通过逻辑值找到物理值,由于我们通常通过逻辑值来定位网格的
    '       物理列（sydz(zdbmte as String,GridStr() as String,szzls as Integer)函数），所以我们只需要
    '       改变GridStr()数组中物理列和逻辑列之间的对应关系，从而达到改变列的目的。
    '扩展：虽然本程序只是针对数据显示网格而作，但是此程序给大家提供了一个思路，通过交换GridBoolean()、
    ' GridInt()、网格列标题wglbt()等数组，就可以实现输入的列移动
    On Error GoTo Err_Ctrl
    
    Dim int_Temp As Integer
    Dim str_temp() As String '用来保存移动开始列的GridStr()信息
    Dim i, j As Long
    
    
    
    '保存移动开始列的GridStr()信息
    ReDim str_temp(0, UBound(GridStr, 2))
    For j = 1 To UBound(GridStr, 2)
        str_temp(0, j) = GridStr(int_StartCol, j)
    Next
    '[[在此加入你的代码，保存当前开始移动列的其他信息]]
    
    '依次移动各列的信息
    If int_StartCol < int_FinishCol Then
        For i = int_StartCol To int_FinishCol - 1
            For j = 1 To UBound(GridStr, 2)
                GridStr(i, j) = GridStr(i + 1, j)
            Next j
        Next i
    Else
        For i = int_StartCol To int_FinishCol + 1 Step -1
            For j = 1 To UBound(GridStr, 2)
                GridStr(i, j) = GridStr(i - 1, j)
            Next j
        Next i
    End If
    '[[在此加入你的代码，依照上面的代码格式，移动列的其他信息]]
    
    '恢复开始移动列的信息到结束列上
    For j = 1 To UBound(GridStr, 2)
        GridStr(int_FinishCol, j) = str_temp(0, j)
    Next j
    
    '[[在此加入你的代码，恢复开始移动列的其他信息到结束列上]]
    
    FnBln_RefreshArray = True
    
Err_Ctrl:
    FnBln_RefreshArray = False
End Function

Public Function Sfyxzx() As Boolean                                '判断是否允许执行某项功能
    Dim Ztxxrec As New ADODB.Recordset
    Dim Tsxx As String
    Sfyxzx = False
    Set Ztxxrec = Cw_DataEnvi.DataConnect.Execute("Select * From Gdzc_ztxx")
    With Ztxxrec
        If Not .EOF Then
            If (Xtyear <> .Fields("ztdqyear")) Or (Xtmm <> .Fields("ztdqmm")) Then
                Tsxx = "选择期间非帐套当前会计期间,此项功能模块不能使用!"
                Call Xtxxts(Tsxx, 0, 4)
                Exit Function
            Else
                If .Fields("sfjtzj") Then
                    Tsxx = "当前会计期间已计提折旧,此项功能模块不能使用!"
                    Tsxx = Tsxx + Chr(10) + "请先将本月执行月末结帐!"
                    Call Xtxxts(Tsxx, 0, 4)
                    Exit Function
                End If
            End If
        End If
    End With
    Sfyxzx = True
End Function

'*/


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 Sub fill_tv(tv As TreeView, flbm As ADODB.Recordset, field1 As String, field2 As String, bmjc_bz As Boolean, tree_name As String, Treeprant As String, Treechr As String)
    '---------------------------------------------