-

VB开发的ERP系统

    '填充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(field1))
            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)
            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)
            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)
            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)
            End Select
            tv.Nodes(count).Expanded = True
            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

Public Sub BalFx(ByVal strItem As String, Optional sHelpID As String)
    If DEBUG_FLAG = False Then On Error Resume Next
    '此过程由系统主面板，树型菜单在单击“资产负债表分析”时调用，参数为模块标识
    '财务分析-资产负债表分析
    'BBFX_FrmBalFx.Show
    
    Dim temRs As New ADODB.Recordset
    Dim mySeachForm As New Bbfx_SelDate
    mySeachForm.Show vbModal
    If mySeachForm.bSeach = True Then '如果单击查询窗体的“确定”按钮则：
        Set temRs = Cw_DataEnvi.DataConnect.Execute("SELECT gnmc FROM xt_xtgnb where gnsy='" & strItem & "'")
        DoEvents
        With Bbfx_FrmBalFx
            If DEBUG_FLAG = False Then
                XT_Wait.Show
                XT_Wait.Refresh
            End If
            DoEvents
            .Caption = "资产负债表分析-" & Trim(temRs!gnmc)
            .TsLabel(4).Caption = "资产负债表分析（" & Trim(temRs!gnmc) & "）"
            .intType = mySeachForm.intType '传递查询参数
            .strBegin = mySeachForm.strBegin '
            .strEnd = mySeachForm.strEnd
            .strItem = strItem
            .bSeach = mySeachForm.bSeach
            .HelpContextID = sHelpID
            Call .FormInit
            .Show '并显示窗体
            If DEBUG_FLAG = False Then
                XT_Wait.Hide
            End If
            
        End With
    End If
    '否则（即击“取消”按钮）退出过程
End Sub

Public Sub BalFx2(ByVal strItem As String, Optional sHelpID As String)
    If DEBUG_FLAG = False Then On Error Resume Next
    '此过程由系统主面板，树型菜单在单击“资产负债表分析”时调用，参数为模块标识
    '财务分析-资产负债表分析
    'BBFX_FrmBalFx.Show
    
    Dim mySeachForm As New Bbfx_SelDate2
    
    
    Dim temRs As New ADODB.Recordset
    mySeachForm.Show vbModal
    If mySeachForm.bSeach = True Then '如果单击查询窗体的“确定”按钮则：
        Set temRs = Cw_DataEnvi.DataConnect.Execute("SELECT gnmc FROM xt_xtgnb where gnsy='" & strItem & "'")
        With Bbfx_FrmBalFx2
            If DEBUG_FLAG = False Then
                XT_Wait.Show
                XT_Wait.Refresh
            End If
            DoEvents
            .Caption = "资产负债表分析-" & Trim(temRs!gnmc)
            .TsLabel(4).Caption = "资产负债表分析（" & Trim(temRs!gnmc) & "）"
            .intType = mySeachForm.intType '传递查询参数
            '----------------------时间传递-----------------
            .iThisYear = mySeachForm.iThisYear
            .iThisMonthBegin = mySeachForm.iThisMonthBegin
            .iThisMonthEnd = mySeachForm.iThisMonthEnd
            .iCompYear = mySeachForm.iCompYear
            .iCompMonthBegin = mySeachForm.iCompMonthBegin
            .iCompMonthEnd = mySeachForm.iCompMonthEnd
            .bSeach = mySeachForm.bSeach
            .HelpContextID = sHelpID
            
            '------------------------------------------------
            .strItem = strItem
            Call .FormInit
            
            
            
            .Show '并显示窗体
            If DEBUG_FLAG = False Then
                XT_Wait.Hide
                ' .Enabled = True
            End If
        End With
    Else
        Bbfx_FrmBalFx2.bSeach = False
    End If
    '否则（即击“取消”按钮）退出过程
End Sub

Public Sub IncFx(ByVal strItem As String, Optional sHelpID As String)
    '负债表分析
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim mySeachForm1 As New Bbfx_SelDate
    Dim mySeachForm2 As New Bbfx_SelDate2
    Dim temRs As New ADODB.Recordset
    Select Case strItem
    Case "cwfx_IncJds", "cwfx_IncDj", "cwfx_IncHb" '绝对数、定基、环比
        mySeachForm1.Show vbModal
    Case "cwfx_IncDb", "cwfx_IncJg" '对比、结构
        mySeachForm2.Show vbModal
    End Select
    
    If mySeachForm1.bSeach = True Or mySeachForm2.bSeach = True Then
        '-----根据不同参数给不同窗体赋值------------------------
        
        Select Case strItem
        Case "cwfx_IncJds", "cwfx_IncDj", "cwfx_IncHb" '绝对数、定基、环比
            With Bbfx_FrmIncFx
                .iThisYear = mySeachForm1.iThisYear
                .iCompYear = mySeachForm1.iCompYear
                .intType = mySeachForm1.intType
                .iThisMonthBegin = mySeachForm1.iThisMonthBegin
                .iThisMonthEnd = mySeachForm1.iThisMonthEnd
                .strBegin = mySeachForm1.strBegin
                .strEnd = mySeachForm1.strEnd
                .bSeach = mySeachForm1.bSeach
                .HelpContextID = sHelpID
                
            End With
        Case "cwfx_IncDb", "cwfx_IncJg" '对比、结构
            With Bbfx_FrmIncFx
                .iThisYear = mySeachForm2.iThisYear
                .intType = mySeachForm2.intType
                .iThisMonthBegin = mySeachForm2.iThisMonthBegin
                .iThisMonthEnd = mySeachForm2.iThisMonthEnd
                .iCompYear = mySeachForm2.iCompYear
                .iCompMonthBegin = mySeachForm2.iCompMonthBegin
                .iCompMonthEnd = mySeachForm2.iCompMonthEnd
                .bIFComp = mySeachForm2.chk_ComSel.Value
                If .bIFComp = False Then
                    .iCompMonthBegin = 0
                    .iCompMonthEnd = 0
                End If
                If .intType = 1 Then
                    .strBegin = .iThisYear & "." & .iThisMonthBegin & "-" & .iThisYear & "." & .iThisMonthEnd
                    If .bIFComp = True Then
                        .strEnd = .iCompYear & "." & .iCompMonthBegin & "-" & .iCompYear & "." & .iCompMonthEnd
                    Else
                        .strEnd = ""
                    End If
                Else
                    .strBegin = ""
                    .strEnd = ""
                End If
                .bSeach = mySeachForm2.bSeach
                .HelpContextID = sHelpID
            End With
        End Select
        '---------------------------------------------------------
        With Bbfx_FrmIncFx
            If DEBUG_FLAG = False Then
                XT_Wait.Show
                XT_Wait.Refresh
            End If
            DoEvents
            .strItem = strItem
            Set temRs = Cw_DataEnvi.DataConnect.Execute("SELECT gnmc FROM xt_xtgnb where gnsy='" & strItem & "'")
            .Caption = "损益表分析-" & Trim(temRs!gnmc)
            .TsLabel(4).Caption = "损益表分析（" & Trim(temRs!gnmc) & "）"
            
            Call .FormInit
            .Show
            If DEBUG_FLAG = False Then
                XT_Wait.Hide
            End If
            If temRs.State = adStateOpen Then temRs.Close
        End With
    Else
        Bbfx_FrmIncFx.bSeach = False
    End If
End Sub