企业管理

开发平台：
Visual Basic

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
'*********************************************************************
'*    模 块 名 称 :产品毛利率分析类模块
'*    功 能 描 述 :
'*    程序员姓名  :白石军
'*    最后修改人  :
'*    最后修改时间:2002/1/21
'*    备        注:程序中所有依实际情况自定义部分均用[>>  <<]括起
'*
'*********************************************************************
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 Zbfx_ProFxSeach
        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)
            '用SQL语句，找出科目代码及期间相符的记录
            '下一步再加入对年/月/季的选择
            If SumRs.State = adStateOpen Then SumRs.Close
            strSql = MakeSQL(strTem)
            Set SumRs = Cw_DataEnvi.DataConnect.Execute(strSql)
            '=============================
            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 = ""
    Select Case Zbfx_ProFxSeach.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

						