企业管理

开发平台：
Visual Basic

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
'*********************************************************************
'*    模 块 名 称 :基本指标分析类模块
'*    功 能 描 述 :
'*    程序员姓名  :白石军
'*    最后修改人  :
'*    最后修改时间:2002/1/21
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'*
'*********************************************************************
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 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
            MakeFormula = 0
        End If
        If dbl_TemValue <> 0 Then
            With Zbfx_BaseGuideLineSeach
                Select Case .Combo_Type.ListIndex
                Case 0
                    MakeFormula = 360 / dbl_TemValue
                Case 1
                    MakeFormula = 360 / dbl_TemValue
                Case 2
                    MakeFormula = 360 / dbl_TemValue
                End Select
            End With
        Else
            MakeFormula = 0
        End If
        
    Case "营业周期"
        MakeFormula = 360 * ((GetPeriodValueInc("产品销售收入", False) / (GetPeriodValue("应收账款净额", True) + GetPeriodValue("应收票据", True))) + (GetPeriodValue("存货", True) / GetPeriodValueInc("产品销售成本", False)))
        
    Case "流动资产周转率"
        dbl_TemValue = GetPeriodValue("流动资产合计", True)
        If dbl_TemValue <> 0 Then
            MakeFormula = GetPeriodValueInc("产品销售收入", False) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "资产负债率"
        dbl_TemValue = GetPeriodValue("资产合计", False)
        If dbl_TemValue <> 0 Then
            MakeFormula = GetPeriodValue("负债合计", False) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "产权比率"
        dbl_TemValue = GetPeriodValue("所有者权益合计", False)
        If dbl_TemValue <> 0 Then
            MakeFormula = GetPeriodValue("负债合计", False) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "销售毛利率"
        dbl_TemValue = GetPeriodValueInc("产品销售收入", False)
        If dbl_TemValue <> 0 Then
            MakeFormula = (GetPeriodValueInc("产品销售收入", False) - GetPeriodValueInc("产品销售成本", False)) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "销售净利率"
        dbl_TemValue = GetPeriodValueInc("产品销售收入", False)
        If dbl_TemValue <> 0 Then
            MakeFormula = GetPeriodValueInc("净利润", False) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "销售成本毛利率"
        dbl_TemValue = GetPeriodValueInc("产品销售成本", False)
        If dbl_TemValue <> 0 Then
            MakeFormula = (GetPeriodValueInc("产品销售收入", False) - dbl_TemValue) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "销售成本净利率"
        dbl_TemValue = GetPeriodValueInc("产品销售成本", False)
        If dbl_TemValue <> 0 Then
            MakeFormula = GetPeriodValueInc("净利润", False) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "总资产报酬率"
        dbl_TemValue = GetPeriodValue("资产合计", True)
        If dbl_TemValue <> 0 Then
            MakeFormula = (GetPeriodValueInc("利润总额", False) + GetPeriodValueInc("财务费用", False)) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "净值报酬率"
        dbl_TemValue = GetPeriodValue("所有者权益合计", True)
        If dbl_TemValue <> 0 Then
            MakeFormula = (GetPeriodValueInc("净利润", False) + GetPeriodValueInc("财务费用", False)) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "每股收益"
        dbl_TemValue = Val(Zbfx_BaseGuideLineSeach.lrText(0).Text)
        If dbl_TemValue <> 0 Then
            MakeFormula = GetPeriodValueInc("净利润", False) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "市盈率"
        dbl_TemValue = Val(Zbfx_BaseGuideLineSeach.lrText(2).Text)
        If dbl_TemValue <> 0 Then
            MakeFormula = Val(Zbfx_BaseGuideLineSeach.lrText(1).Text) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "每股账面价值"
        dbl_TemValue = Val(Zbfx_BaseGuideLineSeach.lrText(0).Text)
        If dbl_TemValue <> 0 Then
            MakeFormula = (GetPeriodValueInc("股东权益总额", False) - Val(Zbfx_BaseGuideLineSeach.lrText(3).Text)) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "产权比率"
        dbl_TemValue = GetPeriodValue("股东权益总额", False)
        If dbl_TemValue <> 0 Then
            MakeFormula = (GetPeriodValue("负债总额", False) + GetPeriodValueInc("财务费用", False)) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "净值报酬率"
        dbl_TemValue = GetPeriodValue("股东权益总额", True)
        If dbl_TemValue <> 0 Then
            MakeFormula = GetPeriodValue("净利润", False) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    Case "每股净资产"
        dbl_TemValue = Val(Zbfx_BaseGuideLineSeach.lrText(0).Text)
        If dbl_TemValue <> 0 Then
            MakeFormula = GetPeriodValue("股东权益总额", False) / dbl_TemValue
        Else
            MakeFormula = 0
        End If
    End Select
End Function
Private Function GetPeriodValue(ByVal strItem As String, ByVal bPingJun As Boolean) As Double
    '按年、按月、按季
    If DEBUG_FLAG = False Then On Error Resume Next
    If myDate = FIRST_DATE Then             '年初
        GetPeriodValue = clsmyBal.GetFristValue(strItem, Xtyear)
    Else
        With Zbfx_BaseGuideLineSeach
            Select Case .Combo_Type.ListIndex
            Case 0                          '按年
                If bPingJun = True Then
                    GetPeriodValue = clsmyBal.GetAveragePeriodValue(strItem, 1, 12, iThisYear)
                Else
                    GetPeriodValue = clsmyBal.GetPeriodValue(strItem, 12, iYear)
                End If
            Case 1                          '按月
                If bPingJun = True Then
                    GetPeriodValue = clsmyBal.GetAveragePeriodValue(strItem, iThisMonthBegin, iThisMonthEnd, iThisYear)
                Else
                    GetPeriodValue = clsmyBal.GetPeriodValue(strItem, iMonthEnd, iYear)
                End If
            Case 2                          '按季
                If bPingJun = True Then
                    GetPeriodValue = clsmyBal.GetAveragePeriodValue(strItem, iThisMonthBegin, iThisMonthEnd, iThisYear)
                Else
                    GetPeriodValue = clsmyBal.GetPeriodValue(strItem, iMonthEnd, iYear)
                End If
            End Select
        End With
    End If
End Function
Private Function GetPeriodValueInc(ByVal strItem As String, ByVal bPingJun As Boolean) As Double
    '按年、按月、按季
    If DEBUG_FLAG = False Then On Error Resume Next
    If myDate = FIRST_DATE Then             '年初
        GetPeriodValueInc = clsmyBal.GetFristValue(strItem, Xtyear)
    Else
        With Zbfx_BaseGuideLineSeach
            Select Case .Combo_Type.ListIndex
            Case 0                          '按年
                If bPingJun = True Then
                    GetPeriodValueInc = clsmyInc.GetAveragePeriodValue(strItem, 1, 12, iThisYear)
                Else
                    GetPeriodValueInc = clsmyInc.GetPeriodValue(strItem, 1, 12, iYear)
                End If
            Case 1                          '按月
                If bPingJun = True Then
                    GetPeriodValueInc = clsmyInc.GetAveragePeriodValue(strItem, iThisMonthBegin, iThisMonthEnd, iThisYear)
                Else
                    GetPeriodValueInc = clsmyInc.GetPeriodValue(strItem, iMonthBegin, iMonthEnd, iYear)
                End If
            Case 2                          '按季
                If bPingJun = True Then
                    GetPeriodValueInc = clsmyInc.GetAveragePeriodValue(strItem, iThisMonthBegin, iThisMonthEnd, iThisYear)
                Else
                    GetPeriodValueInc = clsmyInc.GetPeriodValue(strItem, iMonthBegin, iMonthEnd, iYear)
                End If
            End Select
        End With
    End If
End Function
Private Sub Class_Terminate()
    If DEBUG_FLAG = False Then On Error Resume Next
    If SumRs.State = adStateOpen Then SumRs.Close
    If CodeRs.State = adStateOpen Then CodeRs.Close
    If BalRs.State = adStateOpen Then BalRs.Close
    If IncRs.State = adStateOpen Then IncRs.Close
    If TagRs.State = adStateOpen Then TagRs.Close
    Set CodeRs = Nothing
    Set SumRs = Nothing
    Set BalRs = Nothing
    Set IncRs = Nothing
    Set TagRs = Nothing
    
    Set codeColl = Nothing
    
    Set clsmyBal = Nothing
    Set clsmyInc = Nothing
End Sub

						