clstag.cls

VB开发的ERP系统

        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