clstag.cls

财务分析 财财务分析务分析

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsTag"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'基本指标分析类模块*

Option Explicit
'------------------------------------------------------------------
Private Const compDate = &H100 '比较期
Private Const baseDate = &H200 '本期
Private Const firstDate = &H300 '年初
Private Enum FLAG_DATE
    COMP_DATE = compDate
    BASE_DATE = baseDate
    FIRST_DATE = firstDate
End Enum

Private myDate As FLAG_DATE '期间标识（年初，比较期，本期）
'-----------------------------------------------------------------
Private clsmyBal As New clsBal '资产负债表类
Private clsmyInc As New clsInc '损益表类
'-----------------------------------------------------------------
Private SumRs As New ADODB.Recordset '科目总帐表记录集
Private CodeRs As New ADODB.Recordset '科目表记录集
Private BalRs As New ADODB.Recordset  '报表设置中的资产负债表
Private IncRs As New ADODB.Recordset  '报表设置中的损益表
Private TagRs As New ADODB.Recordset  '指标设置表
'------------------------------------------------------------------
Private iThisYear As Integer '本年
Private iCompYear As Integer '比较期年

Private iThisMonthBegin As Integer '本期间首月
Private iThisMonthEnd As Integer '本期间尾月

Private iCompMonthBegin As Integer  '比较期间首月
Private iCompMonthEnd As Integer  '比较期间尾月
'----------------------------------------------------------------
Private iYear As Integer '查询年
Private iMonthBegin As Integer '查询月
Private iMonthEnd As Integer '查询月
'------------------------------------------------------------------

Private strSubExp As String '当前资产负债表公式，用来保存用户设定的公式
Public iRecordCount As Integer '数组记录条数
Private codeColl As New Collection  '公式中的科目集合

'----------股票数据--------------------
Private lrTextVal(5) As Single
'-----------------------------

Private Sub Class_Initialize()
    If DEBUG_FLAG = False Then On Error Resume Next
    'Set SumRs = Cw_DataEnvi.DataConnect.Execute("select * from Cwzz_AccSum") '科目总帐表记录集
    Set CodeRs = Cw_DataEnvi.DataConnect.Execute("select * from Cwzz_AccCode") '科目表记录集
    Set BalRs = Cw_DataEnvi.DataConnect.Execute("select * from cwfx_BalanceInitial") '报表设置中的资产负债表
    Set IncRs = Cw_DataEnvi.DataConnect.Execute("select * from cwfx_IncomeCostInitial") '报表设置中的损益表
    Set TagRs = Cw_DataEnvi.DataConnect.Execute("select * from cwfx_TagInital where Selected=1") '指标设置表
    Call GetParm
    clsmyBal.Init Cw_DataEnvi.DataConnect
    clsmyInc.Init Cw_DataEnvi.DataConnect
End Sub
Private Sub GetParm()
    '得到查询参数
    If DEBUG_FLAG = False Then On Error Resume Next
    With ZBFX_BaseGuideLineSeach
        Select Case .Combo_Type.ListIndex
            Case 0 '按年
                iThisYear = Xtyear                                                         '本年
                If .Combo_SelYear.ListIndex <> -1 And .Combo_SelYear.ListIndex <> 0 Then
                    iCompYear = .Combo_SelYear.Text                                        '比较期年
                End If
                iThisMonthBegin = 1                                                        '本期间首月
                iThisMonthEnd = 12                                                         '本期间尾月
                
                iCompMonthBegin = 1                                                        '比较期间首月
                iCompMonthBegin = 12                                                       '比较期间尾月
            Case 1 '按月
                iThisYear = Xtyear '本年
                iThisMonthBegin = CInt(Right(.Combo_BaseDate.Text, 2)) '本期间首月
                iThisMonthEnd = iThisMonthBegin '本期间尾月
                If .Combo_CompDate.ListIndex <> -1 And .Combo_CompDate.Enabled = True Then
                    iCompYear = .Combo_SelYear.Text '比较期年
                    iCompMonthBegin = CInt(Right(.Combo_CompDate.Text, 2)) '比较期间首月
                    iCompMonthEnd = iCompMonthBegin '比较期间尾月
                End If
            Case 2 '按季
                iThisYear = Xtyear '本年
                iThisMonthBegin = CInt(Mid(.Combo_BaseDate.Text, 6, 2)) '本期间首月
                iThisMonthEnd = CInt(Right(.Combo_BaseDate.Text, 2)) '本期间尾月
                If .Combo_CompDate.ListIndex <> -1 And .Combo_CompDate.Enabled = True Then
                    iCompYear = .Combo_SelYear.Text
                    iCompMonthBegin = CInt(Mid(.Combo_CompDate.Text, 6, 2)) '比较期间首月
                    iCompMonthEnd = CInt(Right(.Combo_CompDate.Text, 2)) '比较期间尾月
                End If
        End Select
        
        '股票数据
        Dim i As Integer
        For i = .LrText.LBound To .LrText.UBound
            lrTextVal(i) = Val(.LrText(i).Text)
        Next
        
    End With
End Sub
Public Function MakeData() As Boolean
    '此过程为公共接口
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim i As Integer
    iRecordCount = TagRs.RecordCount - 1
    If iRecordCount < 0 Then
        MakeData = False
        Exit Function
    End If
    ReDim TagArry(iRecordCount)
    
    For i = 0 To iRecordCount
        With TagRs
            TagArry(i).strType = Trim(!RatioType)
            TagArry(i).strName = Trim(!RatioName)
            TagArry(i).strUnit = Trim(!Unit)
            
            '------------------------------------------------------------------------
            myDate = BASE_DATE '本期
            iYear = iThisYear
            iMonthBegin = iThisMonthBegin
            iMonthEnd = iThisMonthEnd
            
            TagArry(i).sigCurrentV = MakeFormula(Trim(!RatioName))
            '------------------'比较期------------------------------------------------------
            If ZBFX_BaseGuideLineSeach.Combo_SelYear.ListIndex <> -1 And ZBFX_BaseGuideLineSeach.Combo_SelYear.ListIndex <> 0 Then '比较期
                iYear = iCompYear
                iMonthBegin = iCompMonthBegin
                iMonthEnd = iCompMonthEnd
                
                TagArry(i).sigComPareV = MakeFormula(Trim(!RatioName))

                If TagArry(i).sigComPareV <> 0 And TagArry(i).sigCurrentV <> 0 Then
                    TagArry(i).strTagAdd2 = ((TagArry(i).sigCurrentV - TagArry(i).sigComPareV) * 100 / TagArry(i).sigComPareV)
                End If
            End If
            '---------------------------------------------------------------------------
            myDate = FIRST_DATE '年初
            TagArry(i).sigYearBeginV = MakeFormula(Trim(!RatioName))

            If TagArry(i).sigYearBeginV <> 0 And TagArry(i).sigCurrentV <> 0 Then
                TagArry(i).strTagAdd1 = ((TagArry(i).sigCurrentV - TagArry(i).sigYearBeginV) * 100 / TagArry(i).sigYearBeginV)
            End If
            '------------------------------------------------------------------------------
            .MoveNext
        End With
    Next
    MakeData = True
End Function

Private Function MakeFormula(ByVal strItem As String) As Double
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim dbl_TemValue As Double
    Select Case strItem
        Case "流动比率"
            dbl_TemValue = GetPeriodValue("流动负债合计", False)
            If dbl_TemValue <> 0 Then
                MakeFormula = GetPeriodValue("流动资产合计", False) / dbl_TemValue
            End If
        Case "速动比率"
            dbl_TemValue = GetPeriodValue("流动负债合计", False)
            If dbl_TemValue <> 0 Then
                MakeFormula = (GetPeriodValue("流动资产合计", False) - GetPeriodValue("存货", False)) / dbl_TemValue
            End If
        Case "存货周转率"
            dbl_TemValue = GetPeriodValue("存货", True)
            If dbl_TemValue <> 0 Then
                MakeFormula = GetPeriodValueInc("产品销售成本", False) / dbl_TemValue
            End If
        Case "存货周转天数"
            dbl_TemValue = GetPeriodValueInc("产品销售成本", False)
            If dbl_TemValue <> 0 Then
                With ZBFX_BaseGuideLineSeach
                    Select Case .Combo_Type.ListIndex
                        Case 0
                            MakeFormula = (360 / dbl_TemValue) * GetPeriodValue("存货", True)
                        Case 1
                            MakeFormula = (360 / dbl_TemValue) * GetPeriodValue("存货", True)
                        Case 2
                            MakeFormula = (360 / dbl_TemValue) * GetPeriodValue("存货", True)
                    End Select
                End With
            Else
                MakeFormula = 0
            End If
        Case "应收账款周转率"
            dbl_TemValue = GetPeriodValue("应收账款净额", True) + GetPeriodValue("应收票据", True)
            If dbl_TemValue <> 0 Then
                MakeFormula = GetPeriodValueInc("产品销售收入", False) / dbl_TemValue
            Else
                MakeFormula = 0
            End If
        Case "应收账款周转天数"
            dbl_TemValue = GetPeriodValue("应收账款净额", True) + GetPeriodValue("应收票据", True)
            If dbl_TemValue <> 0 Then
                dbl_TemValue = GetPeriodValueInc("产品销售收入", False) / dbl_TemValue
            Else