financereportwizard.cls

金算盘软件代码

Public Property Get ReferPeriod() As String
    ReferPeriod = mvarReferPeriodType
End Property
Public Property Let ReferPeriod(ByVal vData As String)
    mvarReferPeriodType = vData
End Property
'工资项目
Public Property Let SalaryFieldDesc(ByVal Index As Integer, ByVal vData As String)
    mstrSalaryFieldDesc(Index) = vData
End Property
Public Property Get SalaryFieldDesc(ByVal Index As Integer) As String
    SalaryFieldDesc(Index) = mstrSalaryFieldDesc(Index)
End Property
'工资项目小数位数
Public Property Let SalaryFieldDec(ByVal Index As Integer, ByVal vData As Byte)
    mvarSalaryFieldDec(Index) = vData
End Property
Public Property Get SalaryFieldDec(ByVal Index As Integer) As Byte
    SalaryFieldDec = mvarSalaryFieldDec(Index)
End Property
'按照条件选取的工资项目
Public Property Let SalaryDesc(ByVal vData As String)
    mstrSalaryDesc = vData
End Property
Public Property Get SalaryDesc() As String
    SalaryDesc = mstrSalaryDesc
End Property

'按用户ID重新保存一份列表
Public Sub AddReport()
    Dim rstReport As rdoResultset
    Dim rstMaxReportID As rdoResultset
    Dim strSql As String
    Dim lngReportID As Long
    Dim lngMaxReportID As Long
    strSql = "Select * from Report"
    Set rstReport = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    With rstReport
       .AddNew
          lngReportID = GetNewID("Report")
          !lngViewId = mvarViewID
          !strReportName = mvarReportName
          !lngOperatorID = gclsBase.OperatorID
          !bytPrep = 2
          !bytWizard = 7
          !lngParentId = mlngParentID
          !intLevel = mintParentLevel + 1
          !blnIsDetail = 1
          !strDate = Format(gclsBase.BaseDate, "yyyy-mm-dd")
          !bytAccountStyle = mvarAccountTypeID
          !bytGroup = mbytGroup
          !intGridTop = mvarGridTop
          !lngPrintSetupID = StandardReport.GetPrintSetupID(7, ReportID)
          mlngPrintSetupID = !lngPrintSetupID
          !bytAccountType = mvarAccountStyle
          !bytVersion = mbytVersion
          !bytCondShow = mbytCondShow
          !intOrder = mvarReportOrderType
          !lngReportID = lngReportID
        .Update
       .Close
    End With
    CopyReportField (lngReportID)
    mvarReportID = lngReportID
    EditUpdate
End Sub

Public Sub CopyReportField(ByVal lngReportID As Long)
    Dim strSql As String
    Dim rstSource As rdoResultset
    Dim rstDesc As rdoResultset
    Dim fldReportField As rdoColumn
    Dim colFieldID As Collection
    Dim intLoc As Integer
    Dim lngFieldID As Long
    
     '关闭表触发器
'    strSql = "Alter Table ReportField Disable All Triggers"
'    gclsBase.BaseDB.Execute (strSql)
    
    strSql = "Select * from ReportField Where lngReportId=" & mvarReportID
    Set rstSource = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    strSql = "Select * from ReportField Where lngReportId=" & lngReportID
    Set rstDesc = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurRowVer)
    With rstSource
        Do While Not .EOF
           rstDesc.AddNew
           For Each fldReportField In .rdoColumns
               If UCase(fldReportField.Name) = UCase("lngReportId") Then
                   rstDesc!lngReportID = lngReportID
               Else
                    If UCase(fldReportField.Name) <> UCase("lngReportFieldId") Then
                        rstDesc.rdoColumns(fldReportField.Name).Value = fldReportField.Value
                    Else
                         lngFieldID = BillPublic.GetNewID("ReportField")
                         rstDesc!lngReportFieldID = lngFieldID
                         On Error Resume Next
'                         intLoc = -1
'                         intLoc = colFieldID(CStr(fldReportField.Value))
'                         If intLoc > 0 Then
'                            mvarReportFieldID(intLoc - 1) = lngFieldID
'                         End If
'                         On Error GoTo 0
                    End If
               End If
           Next
           rstDesc.Update
           .MoveNext
        Loop
    End With
     '打开表触发器
'    strSql = "Alter Table ReportField Enable All Triggers"
'    gclsBase.BaseDB.Execute (strSql)
    
    rstDesc.Close
    rstSource.Close
End Sub

'保存报表修改结果
Public Sub SaveList()
    If mbytPrep = 0 Then 'Or mbytPrep = 1
        AddReport
        mbytPrep = 2
    Else
        EditUpdate
    End If
End Sub

'更新用户自定义帐表的修改
Public Sub EditUpdate()
    Dim strSql As String
    Dim intCount As Integer
    strSql = "UPDATE Report Set strReportName = '" & mvarReportName & "'  WHERE Report.lngReportID =" & mvarReportID
    gclsBase.ExecSQL strSql
    strSql = "UPDATE ReportField Set blnIsChoosed= 0 WHERE lngReportID =" & mvarReportID
    gclsBase.ExecSQL strSql
    For intCount = 0 To mvarColumns - 1
        strSql = "Update ReportField" & " Set lngReportFieldNO=" & intCount + 1 & ",strReportFieldDesc='" & _
                            mvarColumnDesc(intCount + 1) & _
                        "',lngDisplayWidth=" & mvarColumnWidth(intCount + 1) & _
                        ",bytSort=" & mvarColumnOrderType(intCount + 1) & _
                        ",blnIsChoosed = " & mvarColumnIsChoosed(intCount + 1) & _
                        " Where lngReportId=" & _
                        mvarReportID & " And lngViewFieldId=" & mvarColumnFieldID(intCount + 1)
        gclsBase.ExecSQL strSql
    Next intCount
End Sub

'取 SELECT 子句
Public Function GetSelect(Optional ByVal intAccountTypeId As Integer, Optional blnCondIsChanged As Boolean = False, Optional blnIsIncludeTax As Boolean = True, Optional blnIsFromWizard As Boolean = False) As String
    Dim intCount As Integer
    Dim strSelect As String
    Dim blnHasAccountTypeCol As Boolean
    Dim intOrderCount As Integer
    Dim intFlag As Integer
    intFlag = 1
    '得到与栏目设置有关的SELECT 子句
    mblnNeedGatherData = False
    mstrOrderBy = ""
    intOrderCount = 0
    For intCount = 1 To Columns
        If Trim(ColumnFieldName(intCount)) <> "" And Trim(ColumnDesc(intCount)) <> "年" And ColumnIsChoosed(intCount) = 1 And IsHeadColumn(intCount) = True Then
            If strSelect = "" Then
                strSelect = ColumnFieldName(intCount) & " As " & """" & ColumnDesc(intCount) & """"
                If InStr(1, ColumnDesc(intCount), "生产批号") = 0 Then
                    mstrOrderSql = ColumnFieldName(intCount) & " As " & ColumnDesc(intCount)
                Else
                    mstrOrderSql = "''" & " As " & ColumnDesc(intCount)
                End If
            Else
                strSelect = strSelect & "," & ColumnFieldName(intCount) & " As " & """" & ColumnDesc(intCount) & """"
                If InStr(1, ColumnDesc(intCount), "生产批号") = 0 Then
                    mstrOrderSql = mstrOrderSql & "," & ColumnFieldName(intCount) & " As " & ColumnDesc(intCount)
                Else
                    mstrOrderSql = mstrOrderSql & "," & "''" & " As " & ColumnDesc(intCount)
                End If
            End If
            If ViewId <> 321 And ViewId <> 682 And ViewId <> 308 Then
                If intOrderCount = 0 Then
                    mstrOrderBy = ColumnFieldName(intCount)
                    intOrderCount = intOrderCount + 1
                End If
            Else
                If mstrOrderBy = "" Then
                    mstrOrderBy = ColumnDesc(intCount)
                Else
                    mstrOrderBy = mstrOrderBy & "," & ColumnDesc(intCount)
                End If
            End If
        End If
        If intFlag = 1 And IsHeadColumn(intCount) = True And (mvarViewID = 245 Or mvarViewID = 246 Or mvarViewID = 503 Or mvarViewID = 306) Then   '只判断第一列
            Select Case mvarColumnDesc(intCount)
                Case "商品编码", "商品名称", "计量单位"
                    mblnNeedGatherData = False
                Case "单位", "业务员"
                    If Columns - DataColumns = 1 Then
                        mblnNeedGatherData = False
                    Else
                        mblnNeedGatherData = True
                    End If
                Case Else
                    mblnNeedGatherData = True
            End Select
            intFlag = 0
        End If
    Next intCount
    
    If mvarReportOrderType = 1 Then
        mstrOrderBy = mstrOrderBy & " Asc"
    ElseIf mvarReportOrderType = 2 Then
        mstrOrderBy = mstrOrderBy & " Desc"
    End If
    
    If ViewId = 657 Or ViewId = 658 Then
            strSelect = "AccountType.lngAccountTypeID  As " & """" & "科目类型序号" & """" & " ,AccountType.strAccountTypeName  As " & """" & "科目类型" & """" & "," & strSelect
            mstrOrderBy = "科目类型序号" & "," & mstrOrderBy
    End If
    Select Case intAccountTypeId
        '财务状况分析表(趋势、比较、结构)
        Case 1, 2, 3
            GetSelect = GetFinanceStatusSQL(strSelect, intAccountTypeId, blnCondIsChanged, blnIsFromWizard)
        '汇率趋势分析表
        Case 55
            GetSelect = GetRateSQL(strSelect, intAccountTypeId, blnCondIsChanged, blnIsFromWizard)
        '采购,销售，库存(40-42:收入等的趋势分析；43:销售比重分析；44:销售同期比较分析)
        Case 5, 6, 7, 40, 41, 42
            strDataAccount = "ItemActivity"
            strDataAccountDetail = "ItemActivityDetail"
            mvarAccountDataType = "ItemActivity"
            If ViewId = 306 Then
                strDataAccount = "StockItemAQ"
                strDataAccountDetail = "StockItemAQ"
                mvarAccountDataType = "StockItemAQ"
            End If
            GetSelect = GetFinanceSQL(strSelect, intAccountTypeId, blnCondIsChanged, blnIsFromWizard)
        '结构分析(包括采购、销售、库存)
        Case 8
            strDataAccount = "ItemActivity"
            strDataAccountDetail = "ItemActivityDetail"
            mvarAccountDataType = "ItemActivity"
            If ViewId = 306 Then
                strDataAccount = "StockItemAQ"
                strDataAccountDetail = "StockItemAQ"
                mvarAccountDataType = "StockItemAQ"
            End If
            GetSelect = GetFinanceSQL(strSelect, intAccountTypeId, blnCondIsChanged, blnIsFromWizard)
        '固定资产
        Case 9, 14, 15, 16, 17, 24
            GetSelect = GetFixedSQL(strSelect, intAccountTypeId, blnCondIsChanged, blnIsFromWizard)
        '工资
        Case 10, 18, 19, 20, 21, 22, 23, 25, 26, 27
            GetSelect = GetSalarySQL(strSelect, intAccountTypeId, blnCondIsChanged, blnIsFromWizard)
        '单价趋势分析
        Case 12
            mvarAccountDataType = "ItemActivity"
            GetSelect = GetPriceSQL(strSelect, intAccountTypeId, blnCondIsChanged, blnIsIncludeTax, blnIsFromWizard)
        '预算分析(包括财务预算、经营预算)
        Case 13, 126
            GetSelect = GetBudgetSQL(strSelect, intAccountTypeId, blnCondIsChanged, blnIsFromWizard)
        '比重、同期比较分析
        Case 43, 44
            mvarAccountDataType = "ItemActivity"
            GetSelect = GetSpecialSQL_1(strSelect, intAccountTypeId, blnCondIsChanged, blnIsFromWizard)
        '库存商品周转表
        Case 45
'            mvarAccountDataType = "ItemActivity"
            mvarAccountDataType = "StockItemAQ"
            GetSelect = GetSpecialSQL_2(strSelect, intAccountTypeId, blnCondIsChanged, blnIsFromWizard)
    End Select
End Function
Public Function GetFrom() As String
    Dim strView As rdoResultset
    Set strView = gclsBase.BaseDB.OpenResultset("Select strViewName,strViewSQL,strViewWhere from View1 Where lngViewId=" & mvarViewID, rdOpenStatic)
    If Not strView.EOF Then
        mvarViewName = strView!strViewName
        mvarFrom = strView!strViewSQL
        mvarViewSQL = strView!strViewSQL
        mvarRelationViewWhere = strView!StrViewWhere
        mvarRelationWhere = mvarRelationViewWhere
        If ViewId = 657 Or ViewId = 658 Then '财务状况分析(不包括期初和期末)
            mvarFrom = GetNoXString(strView!strViewSQL, 1, "|")
            mvarRelationWhere = GetNoXString(mvarRelationViewWhere, 1, "|")
        End If
        If ViewId = 245 Or ViewId = 246 Then '采购、销售分析(不包括订购)
            mvarFrom = GetNoXString(strView!strViewSQL, 1, "#")
            mvarRelationWhere = GetNoXString(mvarRelationViewWhere, 1, "#")
            mstrOrderFrom = GetNoXString(strView!strViewSQL, 2, "#")
            mvarOrderWhere = GetNoXString(mvarRelationViewWhere, 2, "#")
        End If
    End If
    strView.Close
End Function
'取 Where 子句
Public Function GetWhere(Optional ByVal intAccountTypeId As Integer, Optional ByVal intAnalyType As Integer, Optional strActivityTable As String, Optional blnIsFromWizard As Boolean = False, Optional strSpecialRelationWhere As String = "") As String
    Dim strTempWhere As String
    Dim strRelationWhere As String
    Dim intCount As Integer
    Dim strTempGetWhere As String
    Dim strTempLevelCond As String
    If strSpecialRelationWhere = "" Then
        strRelationWhere = mvarRelationWhere
    Else
        strRelationWhere = strSpecialRelationWhere
    End If
    If ReportIsFromWizard = True Then
        For intCount = 0 To CondCount - 1
            If InStr(mstrCondDesc(intCount), "分析期") = 0 And InStr(mstrCondDesc(intCount), "比较期") = 0 And mstrCondDesc(intCount) <> "报告期" And mstrCondDesc(intCount) <> "对比期" And mstrCondDesc(intCount) <> "包含未记帐凭证" Then
                If mstrCondWhere(intCount) <> "" Then
                    If GetWhere = "" Then
                        GetWhere = mstrCondWhere(intCount)
                    Else
                        GetWhere = GetWhere & " And " & mstrCondWhere(intCount)
                    End If
                End If
            End If
        Next
    Else
        GetWhere = Filter.GetInitWhere(ReportID, 2, mstrCondShowing, 1, mstrAccountCond)
        mstrAccountCond = GetNoXString(mstrAccountCond, 1, "`")
        If mstrAccountCond <> "" Then
            If GetWhere = "" Then
                GetWhere = mstrAccountCond
            Else
                GetWhere = GetWhere & " And " & mstrAccountCond
            End If
        End If
    End If
    If GetWhere <> "" Then
        mstrOrderWhere = GetWhere & "  and item.blnIsInActive=0"
    Else
        mstrOrderWhere = " item.blnIsInActive=0 "
    End If
    Select Case ViewId
        Case 245                '采购分析
           strTempWhere = " ReceiptType.lngReceiptTypeID IN " & "(2,3,5,52)" & " And ItemAc