clspro.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 = "clsPro"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'产品毛利率分析类模块

Option Explicit

Private Const costCode = &H100
Private Const comeInCode = &H200
Private Enum FLAG_CODE
    COST_CODE = costCode
    COMEIN_CODE = comeInCode
End Enum

Private SumRs As New ADODB.Recordset '科目总帐表记录集
Private ProRs As New ADODB.Recordset '产品毛利率设置表

Private iCompYear As Integer '比较期年
Private iCompMonth As Integer  '比较期月
Private iThisMonth As Integer '本年月

Private iThisThreeMonthBegin As Integer '本年查询季开始
Private iThisThreeMonthEnd As Integer '本年查询季结束

Private myCode As FLAG_CODE

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

Private Sub Class_Initialize()
    If DEBUG_FLAG = False Then On Error Resume Next
    Set ProRs = Cw_DataEnvi.DataConnect.Execute("select * from cwfx_ProductGrossProfitSet") '产品毛利率设置表
    Call GetParm
End Sub
Private Sub GetParm()
    '得到查询参数
    If DEBUG_FLAG = False Then On Error Resume Next
    With ProFx_Seach
        Select Case .Combo_Type.ListIndex
            Case 0 '按年
            
            Case 1 '按月
                iThisMonth = CInt(Right(.Combo_BaseDate.Text, 2))
            Case 2 '按季
                iThisThreeMonthBegin = Mid(.Combo_BaseDate.Text, 6, 2)
                iThisThreeMonthEnd = CInt(Right(.Combo_BaseDate.Text, 2))
        End Select
    End With
End Sub
Public Function MakeData() As Boolean
    '此过程为公共接口
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim i As Integer
    iRecordCount = ProRs.RecordCount - 1
    If iRecordCount < 0 Then
        MakeData = False
        Exit Function
    End If
    ReDim ProArry(iRecordCount)
    
    For i = 0 To iRecordCount
        With ProRs
            ProArry(i).strName = Trim(!Name)
            myCode = COMEIN_CODE '设置标志：收入科目
            ProArry(i).sigComeIn = GetVal(Trim(!InComeCode))
            myCode = COST_CODE '设置标志：成本科目
            ProArry(i).sigCost = GetVal(Trim(!costCode))
            ProArry(i).sigMaoLi = ProArry(i).sigComeIn - ProArry(i).sigCost
            If ProArry(i).sigComeIn <> 0 Then
                ProArry(i).sigMaoLiLv = (ProArry(i).sigMaoLi / ProArry(i).sigComeIn) * 100
            Else
                ProArry(i).sigMaoLiLv = 0
            End If
            .MoveNext
        End With
    Next
    MakeData = True
End Function

Private Function GetVal(ByVal strItem As String) As Long
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim sigReturn As Long '返回数
    Dim strTem As String
    Dim iLen As Integer
    Dim iWordBegin As Integer
    Dim iWordEnd As Integer
    Dim i As Integer
    Dim j As Integer
    Dim strSql As String
    
    strSubExp = strItem '公式


    '------------------------------------
    '得到科目列表集合
    iLen = Len(strSubExp)
    iWordBegin = 1
    iWordEnd = 1
    For i = 1 To iLen
        
        strTem = Mid(strSubExp, i, 1)
        'iWordEnd = i - 1
        If strTem = "+" Or strTem = "-" Or i = iLen Then
            strTem = Mid(strSubExp, iWordBegin, i - iWordBegin + 1)
            strTem = IIf(Right(strTem, 1) = "+" Or Right(strTem, 1) = "-", Left(strTem, Len(strTem) - 1), strTem)
            '---------------------------
'            If CodeRs.EOF And CodeRs.BOF Then
'                Exit Function
'            End If
            'For j = 1 To codeColl.count
            
            'Next
            '============================
            '用SQL语句，找出科目代码及期间相符的记录
            '下一步再加入对年/月/季的选择
            If SumRs.State = adStateOpen Then SumRs.Close
            strSql = MakeSQL(strTem)
            Set SumRs = Cw_DataEnvi.DataConnect.Execute(strSql)
             'codeColl.Add strTem
            '=============================
            If Not (SumRs.EOF And SumRs.BOF) Then
                '如果是收入则
                If myCode = COMEIN_CODE Then
                    sigReturn = sigReturn + IIf(IsNull(SumRs!dje), 0, SumRs!dje)
                ElseIf myCode = COST_CODE Then  '是成本则
                    sigReturn = sigReturn + IIf(IsNull(SumRs!jje), 0, SumRs!jje)
                End If
            End If
            
            '---------------------------
            iWordBegin = i + 1
        End If
    Next
    '-----------------------------------------------
        
    GetVal = sigReturn
End Function

Private Function MakeSQL(ByVal strItem As String) As String
    '根据查询条件，生成SQL语句
    If DEBUG_FLAG = False Then On Error Resume Next
    Dim strTemSql As String
    '---------------------------------------------------------------------------
    strTemSql = ""
    'strTemSql = "SELECT byjfljje as jje,bydfljje as dje FROM Cwzz_AccSum WHERE cCode='" & strItem & "' "
    Select Case ProFx_Seach.Combo_Type.ListIndex
        Case 0 '按年
            strTemSql = "SELECT Sum(Mjje) as jje,Sum(Mdje) as dje FROM Cwzz_AccSum WHERE cCode='" & strItem & "' AND  Year=" & Xtyear
        Case 1 '按月
            strTemSql = "SELECT Mjje as jje,Mdje as dje FROM Cwzz_AccSum WHERE Period=" & iThisMonth & " AND cCode='" & strItem & "' AND  Year=" & Xtyear
        Case 2 '按季
            strTemSql = "SELECT Sum(Mjje) as jje,Sum(Mdje) as dje FROM Cwzz_AccSum WHERE Period  Between " & iThisThreeMonthBegin & " AND " & iThisThreeMonthEnd & " AND cCode='" & strItem & "' AND Year=" & Xtyear
    End Select
    '-----------------------------------------------------------------------------
    MakeSQL = strTemSql
End Function
Private Sub Class_Terminate()
    If DEBUG_FLAG = False Then On Error Resume Next
    If SumRs.State = adStateOpen Then SumRs.Close
    If ProRs.State = adStateOpen Then ProRs.Close
    
    Set SumRs = Nothing
    Set ProRs = Nothing
    
    Set codeColl = Nothing

End Sub