age.cls

金算盘软件代码

    End With
   
    If Not GetAgePeriod(lngReportID) Then
        GetAgeReportSet = ""
        Exit Function
    End If
    GetHeadTail lngReportID                             '表头表尾
    
    '在 SetConditions 中同时设置了分析日期和截止日期，将影响 SetAgeSelect
    GetAgeConditions lngReportID, ReportViewID          '设置条件
   
    strTemp = ""
    
    '在 SetGroups 中同时设置了栏目已选性质，将影响 SetAgeSelect，所以，先调用 SetGroups
    If SetGroups And SetAgeSelect And SetAgeSQLFrom(ReportViewID) Then      'And SetConditions(ReportViewID)
        strSql1 = mstrSelect1 & " " & mstrFrom1 & " " & mstrWhere1 & " " & mstrGroupBy1 & " " & mstrOrderBy

        GetAgeReportSet = strSql1

        mvarSQLString = GetAgeReportSet
    End If
    GetAgeReportSet = mvarSQLString
End Function


'选应收帐龄天数后，计算期间
Private Sub GetYearMonth()
    Dim strSql As String
    Dim Index As Long
    Dim recMonth As rdoResultset
    Dim strDateFirst As String
    Dim strDatetemp As String
        Select Case AgeViewID
            Case 610
                strSql = "Select strDate from ARAPInit order by strDate "
            Case Else
                strSql = "Select strDate from ARAPInit1 order by strDate "
        End Select
        Set recMonth = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recMonth.EOF Then
            recMonth.MoveFirst
            strDateFirst = IIf(recMonth!strDate <= "1996-01-01", "1996-01-01", recMonth!strDate)
        Else
            strDateFirst = Format(CDate(gclsBase.BeginDate) - 1, "yyyy-mm-dd")
        End If
        recMonth.Close
        mvarYearMonthNumber = 1 + DateDiff("m", CDate(strDateFirst), CDate(AgeEndDate))
        ReDim mvarYearMonth(mvarYearMonthNumber - 1)
        strDatetemp = Format(Format(strDateFirst, "yyyy-mm"), "yyyy-mm-dd")
        For Index = 0 To mvarYearMonthNumber - 1
            mvarYearMonth(Index) = strDatetemp
            strDatetemp = Format(DateAdd("m", 1, CDate(strDatetemp)), "yyyy-mm-dd")
        Next
End Sub


'取当前帐龄表条件，根据报表ID和视图ID从 ReportCond、ReportMultiIDCond 和 ViewField 中读取条件 → 类
Public Function GetAgeConditions(ByVal lngReportID As Long, ByVal ReportViewID As Long) As String
 Dim strTemp As String
'***************        设置应收或应付条件              ***********************************************
   
    If Me.CurrencyID = 0 Then
        mstrWhere1 = " AND   " & IIf(Trim(mstrWhere) <> "", mstrWhere, " 2>1 ")
    Else
        mstrWhere1 = " AND  currencys.lngcurrencyid=" & Me.CurrencyID & IIf(Trim(mstrWhere) <> "", " AND " & mstrWhere, "")
    End If

'**********************         设置两清标志条件    ******************************************************

'    If IsCleared = True Then                '分析未两清往来明细
'        mstrWhere1 = mstrWhere1 & " AND blnIsClosed = 0 "
'    End If
    
'**********************         修正“分析日期”和“截止日期”      *************************************
    AgeStartDate = IIf(Len(AgeStartDate) < 2, "strDueDate", AgeStartDate)
    AgeEndDate = IIf(Len(AgeEndDate) < 2, Format(gclsBase.BaseDate, "yyyy-mm-dd"), AgeEndDate)
    If mbytPrep = 0 Or mbytPrep = 1 And Not mblnOnlyDateChanged Then        '为向导或预置表则“截止日期”为当天
        AgeEndDate = Format(gclsBase.BaseDate, "yyyy-mm-dd")
    End If
    
    If UCase(AgeStartDate) = UCase("strReceiptDate") Then
        AgeDateDesc = "开票日"
    ElseIf UCase(AgeStartDate) = UCase("strDueDate") Then
        AgeDateDesc = "到期日"
    End If
    mblnOnlyDateChanged = False
    
'*********************      分析日期必须为有效日期表达式，科目性质ID必须 > 0        ***********************
    Select Case Me.AgeViewID
        Case 610, 611, 1004, 1005
            strTemp = " AND Account.lngAccountNatureID =3 "
        Case 126, 609, 1006, 1007
            strTemp = " AND Account.lngAccountNatureID =4 "
    End Select
    mstrWhere1 = mstrWhere1 & strTemp
End Function


'保存向导
Public Function SaveWizard() As Boolean
    
    SaveWizard = SaveReport And SaveColumns And SaveAgePeriod And SaveHeadTail 'And SaveConditions

End Function

'新建报表时在 Report 表中添加一条记录
Public Sub AddReport()
    Dim strTemp As String
    Dim rstRecord As rdoResultset
    
    strTemp = "SELECT * FROM Report"
    Set rstRecord = gclsBase.BaseDB.OpenResultset(strTemp, rdOpenDynamic, rdConcurRowVer)
    
    With rstRecord
        .AddNew
        !lngReportID = GetNewID("Report")
        !lngViewId = AgeViewID                      '视图ID
        !strReportName = " " 'AgeName                    '报表名称
        !intLevel = ParentLevel + 1                 '节点层次
        !lngParentId = ParentId                     '父节点ID
        !blnIsDetail = 1                         '末级标志
        !bytPrep = 2                                '自定义类
        mbytPrep = 2
        mvarPre = 2
        !bytWizard = 6                              '帐龄分析
        !strDate = Format(gclsBase.BaseDate, "yyyy-mm-dd")                        '建表日期
'        If AgeReportID > 200 Then
         !lngOperatorID = gclsBase.OperatorID
'        Else
'         !lngOperatorID = 0
'        End If
        !bytAccountStyle = 2 ' AgeViewID                '科目性质:应收或应付
        !bytGroup = GroupNo
        !bytExpandStyle = Me.CurrencyID
        !bytVersion = mvarReportVersionNumber
        If mvarIsGrouped Then                       '科目类型:汇总表或明细表
            !bytAccountType = 1
        Else
            !bytAccountType = 2
        End If
        !intDirection = IIf(Trim(AgeDateDesc) = "到期日", 0, 1)
'        !strSql = IIf(Len(SQLString) <= 0, " ", SQLString)                     'SQL 语句
        AgeReportID = !lngReportID                     '报表ID（自动编号）
        .Update
        
    End With

End Sub

'保存当前报表到 Report 表
Private Function SaveReport() As Boolean
    Dim strTemp As String
    Dim rstRecord As rdoResultset
    Dim lngTempID2 As Long
    Dim blnEndDateSaved As Boolean
    
    strTemp = "SELECT * FROM Report WHERE lngReportID = " & AgeReportID
    
    Set rstRecord = gclsBase.BaseDB.OpenResultset(strTemp, rdOpenDynamic, rdConcurRowVer)
    
    If rstRecord.EOF Then
        SaveReport = False
        Exit Function
    End If
    
    With rstRecord
        .MoveLast
        .Edit               '修改原有记录
        !lngOperatorID = IIf(!lngOperatorID = 0, gclsBase.OperatorID, !lngOperatorID)
        !lngViewId = AgeViewID                      '视图ID
        !strReportName = AgeName                    '报表名称
        !intLevel = ParentLevel + 1                 '节点层次
        !lngParentId = ParentId                     '父节点ID
        !blnIsDetail = 1                         '末级标志
        !bytPrep = mbytPrep '2                      '自定义类
        mvarPre = mbytPrep
        !bytWizard = 6                              '帐龄分析
        !bytVersion = mvarReportVersionNumber
        !strDate = Format(gclsBase.BaseDate, "yyyy-mm-dd")                       '建表日期
        !bytAccountStyle = 2 ' AgeViewID                '科目性质:应收或应付
        !bytExpandStyle = Me.CurrencyID
        If mvarIsGrouped Then                       '科目类型:汇总表或明细表
            !bytAccountType = 1
        Else
            !bytAccountType = 2
        End If
        !intDirection = IIf(Trim(AgeDateDesc) = "到期日", 0, 1)
'        !blnIsDivide = mvarDivide
'        !blnIsShowCent = mvarShowCent
'        !blnIsShowZero = mvarShowZero
'        !bytShowNegivate = mvarShowNegivate
'        !strSql = IIf(Len(SQLString) <= 0, " ", SQLString)                     'SQL 语句
        !bytRowTotalMethod = DataType
        !lngPrintSetupID = PrintID                      '打印设置ID
        !bytGroup = GroupNo
        !intGridTop = GridTop
        AgeReportID = !lngReportID                     '报表ID（自动编号）
        .Update
        
    End With
    
'    **********************         保存特殊条件“分析日期”和“截止日期”      *************************
'    lngTempID1 = FindViewFieldID("分析日期")
'    lngTempID2 = FindViewFieldID("截止日期")
'
'    strTemp = "SELECT * FROM ReportCond WHERE lngReportID = " & AgeReportID
'    Set rstRecord = gclsBase.BaseDB.OpenResultset(strTemp, rdOpenDynamic, rdConcurRowVer)
'
'    With rstRecord
'        If Not .BOF Then
'            .MoveFirst
'        End If
'        blnEndDateSaved = False
'        Do While Not .EOF
'            .Edit
''            If !lngViewFieldID = lngTempID1 Then
''                !strString1 = AgeDateDesc
''                blnStartDateSaved = True
'            If !lngViewFieldID = lngTempID2 Then
'                !dtmDate1 = CDate(AgeEndDate)
'                blnEndDateSaved = True
'            End If
'            .Update
'            .MoveNext
'        Loop
'
''        If Not blnStartDateSaved Then
''            If Not .BOF Then
''                .MoveFirst
''            End If
''            .AddNew
''            !lngViewFieldID = lngTempID1
''            !strPath = "分析日期"
''            !strString1 = AgeDateDesc
''            !lngReportID = AgeReportID
''            .Update
''        End If
'
'        If Not blnEndDateSaved Then
'            .AddNew
'            !lngViewFieldID = lngTempID2
'            !strPath = "截止日期"
'            !dtmDate1 = CDate(AgeEndDate)
'            !lngReportID = AgeReportID
'            .Update
'        End If
'
'    End With
'
    SaveReport = True
End Function

''从 ViewField 表中获取字段的视图 ID
'Private Function FindViewFieldID(ByVal strStr As String) As Long
'    Dim i As Integer
'    Dim strSql As String
'    Dim rstR1 As rdoResultset
'
'    strSql = "SELECT * FROM ViewField WHERE lngViewID = " & AgeViewID
'    Set rstR1 = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'
'    If Not rstR1.BOF Then
'        rstR1.MoveFirst
'    End If
'
'    With rstR1
'        Do While Not .EOF
'            If !strViewFieldDesc = strStr Then
'                FindViewFieldID = !lngViewFieldID
'                Exit Do
'            Else
'                .MoveNext
'            End If
'        Loop
'    End With
'
'End Function

'保存报表字段到 ReportField 表
Private Function SaveColumns() As Boolean
    Dim strStr As String
    Dim rstRecord As rdoResultset
    Dim rstRecord1 As rdoResultset
    Dim i As Integer
    
    strStr = "DELETE  FROM ReportField WHERE lngReportID = " & AgeReportID
    gclsBase.BaseDB.Execute (strStr)
    
    strStr = "SELECT * FROM ReportField"
    Set rstRecord = gclsBase.BaseDB.OpenResultset(strStr, rdOpenDynamic, rdConcurRowVer)
    
    With rstRecord
        
'        .MoveLast
        
        For i = 0 To ColNumber - 1
            .AddNew
            !lngReportFieldID = GetNewID("ReportField")
            !lngReportID = AgeReportID
            !lngViewFieldID = colFieldID(i) ' rstRecord1!lngViewFieldID
            !lngReportFieldNO = i + 1
            !strReportFieldDesc = colDesc(i)
            !lngDisplayWidth = ColWidth(i)
            !bytReportFieldType = ColType(i)
            !bytsort = ColOrderType(i)
            !blnIsChoosed = IIf(ColIsChoosed(i), 1, 0)
            !blnIsHeaded = IIf(IsHeadCol(i), 1, 0)
            !bytVersion = ColVersionType(i)
            .Update
            
        Next i
        
    End With
    
    SaveColumns = True
End Function

'设置 Select 子句，从类模块的“区间”和“栏目”属性进行设置
'
'SELECT 语句组成：
'   = SELECT + 栏目字段 + ( 区间字段 + 百分比字段 + ......) + 合计字段

Private Function SetAgeSelect() As Boolean
    Dim intI As Integer
    Dim strTemp, strTemp1, strTemp2, strTemp3 As String
    Dim strS1, strS2 As String
    Dim strField1, strField2, strField3 As String                'ReportField 中的字段，不用别名
    Dim strAgePeriod1 As String              '区间字段，不用别名
    Dim strAgePeriod2 As String              '区间字段，不用别名
    Dim strAgePeriod3 As String              '区间字段，不用别名
    Dim strSum As String                    '合计字段，非真实数据，不用别名
    Dim strPercent As String                '百分比字段，非真实数据
    Dim strAmount1 As String
    Dim strAgeYearMonth As String
    Dim strZLTSField As String
    'ReportField 中的字段
    strTemp1 = ""
    strField1 = ""
    mstrOrderBy = ""
    mstrSelect1 = ""
    
    '帐龄天数的字段名
    AgeEndDate = IIf(Len(AgeEndDate) <= 0, Format(gclsBase.BaseDate, "yyyy-mm-dd"), AgeEndDate)            '截止日期
    AgeStartDate = IIf(Len(AgeStartDate) <= 0, "strDueDate", AgeStartDate)      '分析日期默认为“到期日”
    strS1 = AgeEndDate
    strS2 = IIf(Len(AgeStartDate) <= 0, "strDueDate", AgeStartDate)             '分析日期
    strS1 = "TO_DATE(" & "'" & strS1 & "','yyyy-mm-dd') - TO_Date(" & strS2 & ",'yyyy-mm-dd')"         '区间条件
    mstrWhere1 = mstrWhere1 & " and TO_DATE(strDateKey,'yyyy-mm-dd')<=TO_DATE('" & AgeEndDate & "','yyyy-mm-dd') "
    
    mHaveChooseZLTS = False
    mvarYearMonthNumber = 0
    For intI = 0 To ColNumber - 1                                   '注：用别名
'        strTemp1 = IIf(ColIsChoosed(intI), IIf(colDesc(intI) = "帐龄天数", "Decode(sign(" & strZLTSField & "-0),1,TO_NUMBER(" & strS1 & "),0)", ColName(intI)) & " AS " & """" & colDesc(intI) & """", "")
        If Not mblnIsHeadCol(intI) Then
            strTemp1 = IIf(ColIsChoosed(intI), IIf(colDesc(intI) = "帐龄天数", "TO_NUMBER(" & strS1 & ")", ColName(intI)) & " AS " & """" & colDesc(intI) & """", "")
             
            If ColIsChoosed(intI) And colDesc(intI) = "应收帐龄天数" And (AgeViewID = 610 Or AgeViewID = 1005) Then
                mHaveChooseZLTS = True
            End If
            
            If strField1 <> "" And strTemp1 <> "" Then
                strField1 = strField1 & "," & strTemp1