frmfinancereport.frm

金算盘软件代码

        ReferBeginDate.Enabled = False
        ReferEndDate.Enabled = False
        AnalyBeginDate.Enabled = False
        AnalyEndDate.Enabled = False
        cmbAnalyDate.Enabled = False
        cmbReferDate.Enabled = False
    Else
        txtReportPeriod.Enabled = True
        ReferBeginDate.Enabled = True
        ReferEndDate.Enabled = True
        AnalyBeginDate.Enabled = True
        AnalyEndDate.Enabled = True
        cmbAnalyDate.Enabled = True
        cmbReferDate.Enabled = True
    End If
    Me.Refresh
End Sub
'结构分析设置(横向)
Private Sub ColumnAnanly()
    Dim rs As rdoResultset
    Dim Strsql As String
    If mblnQueryHasRecord = False Then
        Exit Sub
    End If
    If mblnIsReferPeriod = True Then
        CountReferSum
    Else
        Strsql = "SELECT * FROM ReportConAnalysis WHERE lngReportID = " & mclsFinanceReport.ReportID
        Set rs = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
        If rs.EOF = True Then
            rs.Close
            Exit Sub
        End If
        If rs!bytType = 2 Or rs!bytType = 0 Then
            rs.Close
            Exit Sub
        End If
        grdAcntBook.Redraw = False
        CountSum
        grdAcntBook.Redraw = True
        rs.Close
    End If
End Sub
Private Sub CountReferSum()
    Dim intRows As Integer
    Dim intCols As Integer
    Dim intBeginCol As Integer
    Dim intColIndex As Integer
    Dim intRowIndex As Integer
    Dim dblAnaly As Double              '分析期数据
    Dim dblRefer As Double              '比较期数据
    Dim dblMinus As Double
    intRows = grdAcntBook.Rows - 1
    intCols = grdAcntBook.Cols - 1
    intBeginCol = mclsFinanceReport.Columns
    For intRowIndex = 1 To intRows
        grdAcntBook.Row = intRowIndex
        intColIndex = intBeginCol
        Do While intColIndex <= intCols
            grdAcntBook.col = intColIndex
            dblAnaly = CDbl(grdAcntBook.Text)
            intColIndex = intColIndex + 1
            grdAcntBook.col = intColIndex
            dblRefer = CDbl(grdAcntBook.Text)
            dblMinus = dblAnaly - dblRefer
            intColIndex = intColIndex + 1
            grdAcntBook.col = intColIndex
            grdAcntBook.Text = CStr(dblMinus)                           '增减额
            intColIndex = intColIndex + 1
            grdAcntBook.col = intColIndex
            If dblRefer <> 0 Then                                       '增减率
                grdAcntBook.Text = CStr(dblMinus / dblRefer * 100)
            Else
                grdAcntBook.Text = "0"
            End If
            intColIndex = intColIndex + 1
        Loop
    Next
End Sub
'计算合计栏数据
Private Sub CountSum()
    Dim intRows As Integer
    Dim intCols As Integer
    Dim intSumCols As Integer
    Dim intPartCols As Integer
    Dim intColIndex As Integer
    Dim intRowIndex As Integer
    intRows = grdAcntBook.Rows - 1
    intCols = grdAcntBook.Cols - 1
    grdAcntBook.Row = 0
    For intColIndex = mclsFinanceReport.Columns To grdAcntBook.Cols - 1
        grdAcntBook.col = intColIndex
        If Trim(Right(grdAcntBook.Text, 2)) = "合计" Then
            intSumCols = intSumCols + 1
        End If
        If Trim(Right(grdAcntBook.Text, 3)) = "(%)" Then
            intPartCols = intPartCols + 1
        End If
    Next
    '计算合计数存入数组
    ReDim dblColSumData(1 To intRows, intSumCols)
    ReDim dblColPartData(1 To intRows, intPartCols)
    Dim intArrSumCol As Integer
    Dim intArrPartCol As Integer
    Dim strReportPeriodType As String
    Dim lngPeriodPos As Long
    Dim strDataType As String
    Dim intFindStartCol As Integer
    Dim intBeginCol As Integer
    strReportPeriodType = txtReportPeriod.Text
    intFindStartCol = mclsFinanceReport.Columns
    Do While intFindStartCol <= intCols
        grdAcntBook.Row = 0
        grdAcntBook.col = intFindStartCol
        intBeginCol = intFindStartCol
        strDataType = Right(grdAcntBook.Text, Len(grdAcntBook.Text) - InStr(1, grdAcntBook.Text, strReportPeriodType))
        If Trim(Right(strDataType, 2)) = "合计" Or Trim(Right(strDataType, 3)) = "(%)" Or Trim(Right(strDataType, 2)) = "单价" Then
            intFindStartCol = intFindStartCol + 1
        Else
            For intColIndex = intBeginCol To intCols
                grdAcntBook.col = intColIndex
                If Trim(Right(grdAcntBook.Text, Len(strDataType))) = Trim(strDataType) Then
                    intFindStartCol = intFindStartCol + 1
                Else
                    Exit For
                End If
            Next
            For intRowIndex = 1 To intRows
                grdAcntBook.Row = intRowIndex
                For intColIndex = intBeginCol To intFindStartCol - 1
                    grdAcntBook.col = intColIndex
                    dblColSumData(intRowIndex, intArrSumCol) = dblColSumData(intRowIndex, intArrSumCol) + CDbl(grdAcntBook.Text)
                Next
                For intColIndex = intBeginCol To intFindStartCol - 1
                    grdAcntBook.col = intColIndex
                    If dblColSumData(intRowIndex, intArrSumCol) > 0 Then
                        dblColPartData(intRowIndex, intColIndex - intBeginCol + intArrPartCol) = CDbl(grdAcntBook.Text) / dblColSumData(intRowIndex, intArrSumCol) * 100
                    Else
                        dblColPartData(intRowIndex, intColIndex - intBeginCol + intArrPartCol) = 0
                    End If
                Next
            Next
            intArrPartCol = intArrPartCol + intFindStartCol - intBeginCol
            intArrSumCol = intArrSumCol + 1
        End If
    Loop
    FillSumPart
End Sub
'将合计数组填入合计栏中,并填写比重栏
Private Sub FillSumPart()
    Dim intColIndex As Integer
    Dim intRowIndex As Integer
    Dim intRows As Integer
    Dim intCols As Integer
    Dim intSumArrIndex As Integer
    Dim intPartArrIndex As Integer
    Dim intBeginCol As Integer
    intBeginCol = mclsFinanceReport.Columns
    intRows = grdAcntBook.Rows - 1
    intCols = grdAcntBook.Cols - 1
    For intColIndex = intBeginCol To intCols
        grdAcntBook.Row = 0
        grdAcntBook.col = intColIndex
        If Right(grdAcntBook.Text, 2) = "合计" Then
            For intRowIndex = 1 To intRows
                grdAcntBook.Row = intRowIndex
                grdAcntBook.Text = dblColSumData(intRowIndex, intSumArrIndex)
            Next
            intSumArrIndex = intSumArrIndex + 1
        End If
        If Right(grdAcntBook.Text, 3) = "(%)" Then
            For intRowIndex = 1 To intRows
                grdAcntBook.Row = intRowIndex
                grdAcntBook.Text = dblColPartData(intRowIndex, intPartArrIndex)
            Next
            intPartArrIndex = intPartArrIndex + 1
        End If
    Next
End Sub
'结构分析设置(纵向)
Private Sub StrucAnaly()
    Dim rs As rdoResultset
    Dim Strsql As String
    If mblnQueryHasRecord = False Then
        Exit Sub
    End If
    Strsql = "SELECT * FROM ReportConAnalysis WHERE lngReportID = " & mclsFinanceReport.ReportID
    Set rs = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
    If rs.EOF = True Then
        rs.Close
        Exit Sub
    End If
    If rs!bytType = 1 Or rs!bytType = 0 Then
        rs.Close
        Exit Sub
    End If
    If rs!lngViewFieldID <= 0 Then
        rs.Close
        Exit Sub
    End If
    grdAcntBook.Redraw = False
    CountData
    grdAcntBook.Redraw = True
    rs.Close
End Sub

'计算要在表格纵向上添加的行数
Private Function CountRows() As Integer
    Dim intRows As Integer
    Dim intRowIndex As Integer
    Dim intColIndex As Integer
    Dim strTempText As String
    Dim strCurrText As String
    Dim Count As Integer
    intRows = grdAcntBook.Rows
    grdAcntBook.col = 0
    grdAcntBook.Row = 0
    If Trim(grdAcntBook.Text) = "科目" Then
        grdAcntBook.col = 0
        grdAcntBook.Row = 1
        strTempText = Left(grdAcntBook.Text, 3)
        Count = 1
        For intRowIndex = 1 To intRows - 1
            grdAcntBook.Row = intRowIndex
            strCurrText = Left(grdAcntBook.Text, 3)
            
            If strCurrText <> strTempText Then
                strTempText = strCurrText
                Count = Count + 1
            End If
        Next
    Else
        grdAcntBook.col = 0
        grdAcntBook.Row = 1
        strTempText = grdAcntBook.Text
        Count = 1
        For intRowIndex = 1 To intRows - 1
            grdAcntBook.Row = intRowIndex
            strCurrText = grdAcntBook.Text
            If strCurrText <> strTempText Then
                strTempText = strCurrText
                Count = Count + 1
            End If
        Next
    End If
    CountRows = Count
End Function

'统计要添加的数据,并将统计完的数据逐行加入到表格相应的位置
Private Sub CountData()
    Dim ArrRows As Integer
    Dim ArrCols As Integer
    Dim intRows As Integer
    Dim intCols As Integer
    Dim intRowIndex As Integer
    Dim intColIndex As Integer
    Dim intDataBeginCol As Integer
    Dim dblTempSum As Single
    Dim strTemp As String
    Dim strCurr As String
    Dim strCurr1 As String
    Dim intArrRow As Integer
    Dim intArrCol As Integer
    '数据起始列
    intDataBeginCol = mclsFinanceReport.Columns
    intRows = grdAcntBook.Rows
    intCols = grdAcntBook.Cols
    ArrRows = CountRows
    ArrCols = intCols - mclsFinanceReport.Columns
    ReDim dblAnalyData(ArrRows, ArrCols)
    ReDim dblAnalySum(ArrCols)
    ReDim strRateCols(ArrCols)
    '找出为比率的列
    grdAcntBook.Row = 0
    For intColIndex = 0 To ArrCols - 1
        grdAcntBook.col = intColIndex + intDataBeginCol
        If Trim(Right(grdAcntBook.Text, 3)) = "(%)" Then
            strRateCols(intColIndex) = Trim(Right(grdAcntBook.Text, 3))
        Else
            strRateCols(intColIndex) = ""
        End If
    Next
    grdAcntBook.Row = 1
    grdAcntBook.col = 0
    strTemp = Left(grdAcntBook.Text, 3)
    grdAcntBook.Row = 0
    grdAcntBook.col = 0
    If Trim(grdAcntBook.Text) = "科目" Then
        For intColIndex = 0 To ArrCols - 1
            grdAcntBook.col = 0
            grdAcntBook.Row = 1
            strTemp = Left(grdAcntBook.Text, 3)
            intArrRow = 0
            If strRateCols(intColIndex) = "" Then
                For intRowIndex = 1 To intRows - 1
                    grdAcntBook.col = 0
                    grdAcntBook.Row = intRowIndex
                    strCurr = grdAcntBook.Text
                    strCurr = GetNoXString(strCurr, 1, " ")
                    grdAcntBook.col = intColIndex + intDataBeginCol
                    If strCurr = strTemp And Len(strCurr) = 3 Then
                        dblTempSum = dblTempSum + CSng(grdAcntBook.Text)
                    ElseIf strCurr <> strTemp And Len(strCurr) = 3 Then
                        strTemp = Left(strCurr, 3)
                        dblAnalyData(intArrRow, intColIndex) = Format(dblTempSum, "##,##0.00")
                        dblTempSum = CSng(grdAcntBook.Text)
                        intArrRow = intArrRow + 1
                    ElseIf strCurr <> strTemp And Len(strCurr) > 3 Then
                        If strCurr1 = "" Then
                            strCurr1 = strCurr
                        ElseIf strCurr1 <> "" And Left(strCurr1, 3) <> Left(strCurr, 3) Then
                            strCurr1 = strCurr
                            If Left(strCurr1, 3) <> strTemp Then
                                dblAnalyData(intArrRow, intColIndex) = Format(dblTempSum, "##,##0.00")
                                dblTempSum = 0
                                intArrRow = intArrRow + 1
                            End If
                        End If
                        strCurr = strTemp
                    End If
                Next
                If strCurr = strTemp And intRowIndex >= intRows And Len(strCurr) = 3 Then
                    dblAnalyData(intArrRow, intColIndex) = Format(dblTempSum, "##,##0.00")
                    dblTempSum = 0
                End If
            End If
         Next
    Else
        strTemp = grdAcntBook.Text
        For intColIndex = 0 To ArrCols - 1
            grdAcntBook.col = 0
            grdAcntBook.Row = 1
            strTemp = grdAcntBook.Text
            intArrRow = 0
            If strRateCols(intColIndex) = "" Then
                For intRowIndex = 1 To intRows - 1
                    grdAcntBook.Row = intRowIndex
                    grdAcntBook.col = 0
                    strCurr = grdAcntBook.Text
                    grdAcntBook.col = intColIndex + intDataBeginCol
                    If strCurr = strTemp Then
                        dblTempSum = dblTempSum + CSng(grdAcntBook.Text)
                    ElseIf strCurr <> strTemp Then
                        strTemp = strCurr
                        dblAnalyData(intArrRow, intColIndex) = Format(dblTempSum, "##,##0.00")
                        dblTempSum = CSng(grdAcntBook.Text)
                        intArrRow = intArrRow + 1
                    End If
                Next