budgetlist.frm

金算盘软件代码

    msgBudget(1).Visible = True
    msgBudget(0).Refresh
    msgBudget(1).Refresh
    Me.Show
    Me.ZOrder 0
End Sub

Public Property Let CardIsShow(ByVal vNewValue As Boolean)
    mblnIsShow = vNewValue
End Property

'初试化计划预算
Private Sub SetListText()
    Dim strSql As String
    
    '初试化预算方案
    With lstBudget
        .ClearRefer
        .SeekCol = "1,2,3"
        .CodeSort = True
        strSql = "Select lngBudgetID,strBudgetName From Budget WHERE bytType=" & mintFlag
        Set .Recordset = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        .AddRefer "<新增>", 0, 1     '设置固定选项
        .AddRefer "<修改>", 1, 1
        .AddRefer "<删除>", 2, 1
    End With
End Sub

'初试化会计年度
Private Sub InitAccountYear()
    Dim recTemp As rdoResultset
    
    Set recTemp = gclsBase.BaseDB.OpenResultset("SELECT intYear FROM AccountYear", rdOpenStatic)
    Do While Not recTemp.EOF
        cboBudget.AddItem recTemp("intYear")
        recTemp.MoveNext
    Loop
    If cboBudget.ListCount > 0 Then
        cboBudget.ListIndex = 0
        GetPeriodNO cboBudget.list(0)
    End If
    recTemp.Close
End Sub

'得到期间数
Private Sub GetPeriodNO(ByVal intYear As Integer)
    Dim recTemp As rdoResultset
    
    Set recTemp = gclsBase.BaseDB.OpenResultset("SELECT bytPeriodNO FROM AccountYear WHERE intYear=" & intYear, rdOpenStatic)
    If Not recTemp.EOF Then
        mintPeriodNO = recTemp("bytPeriodNO")
    Else
    
    End If
    recTemp.Close
End Sub

'得到计划预算列表记录集
Private Sub GetList(Optional strWhere As String = "")
    Dim qryTemp As rdoQuery
    Dim strSql As String
    Dim strBudgetQuery1Sql As String
    Dim strBudgetQuerySql As String
    Dim strTmp As String
    Dim recTmp As rdoResultset
    Dim strTmpsql As String
    Dim i As Integer
    Dim j As Integer
    Dim intOldCols As Integer
    Dim rec1 As rdoResultset
    Dim rec2 As rdoResultset
    Dim rec3 As rdoResultset
    Dim strTmpDec As String
    Dim strTmpQuantityDec As String
    Dim strTmpCurrencyDec As String

    If strWhere = "" Then
        If mintFlag = 1 Then
'            With gclsBase.BaseDB.QueryDefs("BudgetQuery1")
'                If cboBudget.Text = "" Then
'                    .Parameters("Year") = 1998
'                Else
'                    .Parameters("Year") = cboBudget.Text
'                End If
'                .Parameters("BudgetID") = mlngBudgetID
'                Set dtaBudget.Recordset = .OpenRecordset
'            End With

            '原币部分
            strBudgetQuery1Sql = TransferPublic.getBudgetQuery1OraSql(1)
            If cboBudget.Text = "" Then
                strBudgetQuery1Sql = Salary.Change_Text("[Year]", "1998", strBudgetQuery1Sql)
            Else
                strBudgetQuery1Sql = Salary.Change_Text("[Year]", cboBudget.Text, strBudgetQuery1Sql)
            End If
            strBudgetQuery1Sql = Salary.Change_Text("[BudgetID]", mlngBudgetID, strBudgetQuery1Sql)
            Set dtaBudget.Resultset = gclsBase.BaseDB.OpenResultset(strBudgetQuery1Sql, rdOpenStatic)
            '本币部分
            strBudgetQuery1Sql = TransferPublic.getBudgetQuery1OraSql(2)
            If cboBudget.Text = "" Then
                strBudgetQuery1Sql = Salary.Change_Text("[Year]", "1998", strBudgetQuery1Sql)
            Else
                strBudgetQuery1Sql = Salary.Change_Text("[Year]", cboBudget.Text, strBudgetQuery1Sql)
            End If
            strBudgetQuery1Sql = Salary.Change_Text("[BudgetID]", mlngBudgetID, strBudgetQuery1Sql)
            Set rec2 = gclsBase.BaseDB.OpenResultset(strBudgetQuery1Sql, rdOpenStatic)
            '数量部分
            strBudgetQuery1Sql = TransferPublic.getBudgetQuery1OraSql(3)
            If cboBudget.Text = "" Then
                strBudgetQuery1Sql = Salary.Change_Text("[Year]", "1998", strBudgetQuery1Sql)
            Else
                strBudgetQuery1Sql = Salary.Change_Text("[Year]", cboBudget.Text, strBudgetQuery1Sql)
            End If
            strBudgetQuery1Sql = Salary.Change_Text("[BudgetID]", mlngBudgetID, strBudgetQuery1Sql)
            Set rec3 = gclsBase.BaseDB.OpenResultset(strBudgetQuery1Sql, rdOpenStatic)
            With msgBudget(1)
                intOldCols = .Cols
                .Cols = .Cols + rec2.rdoColumns.Count - 11
                For j = intOldCols To intOldCols + rec2.rdoColumns.Count - 12
                    .TextMatrix(0, j) = rec2.rdoColumns(j - intOldCols).Name
                Next
                If Not rec2.EOF Then
                    rec2.MoveLast
                    rec2.MoveFirst
                    For i = 0 To rec2.RowCount - 1
                        For j = intOldCols To intOldCols + rec2.rdoColumns.Count - 12
                            .TextMatrix(i + 1, j) = rec2.rdoColumns(j - intOldCols).Value
                        Next
                        rec2.MoveNext
                    Next
                End If
                intOldCols = .Cols
                .Cols = .Cols + rec3.rdoColumns.Count - 11
                For j = intOldCols To intOldCols + rec3.rdoColumns.Count - 12
                    .TextMatrix(0, j) = rec3.rdoColumns(j - intOldCols).Name
                Next
                If Not rec3.EOF Then
                    rec3.MoveLast
                    rec3.MoveFirst
                    For i = 0 To rec3.RowCount - 1
                        For j = intOldCols To intOldCols + rec3.rdoColumns.Count - 12
                            .TextMatrix(i + 1, j) = rec3.rdoColumns(j - intOldCols).Value
                        Next
                        rec3.MoveNext
                    Next
                End If
            End With
        Else
'            With gclsBase.BaseDB.QueryDefs("BudgetQuery")
'                If cboBudget.Text = "" Then
'                    .Parameters("Year") = 1998
'                Else
'                    .Parameters("Year") = cboBudget.Text
'                End If
'                .Parameters("BudgetID") = mlngBudgetID
'                .Parameters("strDec") = IIf(gclsBase.GetCurrencyDec("人民币") = 0, "#,###,###,###", "999,999,999,999,999,999,999,999,990." + String(gclsBase.GetCurrencyDec("人民币"), "0"))
'                .Parameters("strQuantityDec") = IIf(gclsBase.QuantityDec = 0, "#,###,###,###", "999,999,999,999,999,999,999,999,990." + String(gclsBase.QuantityDec, "0"))
'                Set dtaBudget.Recordset = .OpenRecordset
'            End With

            'ID部分
            strBudgetQuerySql = TransferPublic.getBudgetQueryOraSql(0)
            If cboBudget.Text = "" Then
                strBudgetQuerySql = Salary.Change_Text("[Year]", "1998", strBudgetQuerySql)
            Else
                strBudgetQuerySql = Salary.Change_Text("[Year]", cboBudget.Text, strBudgetQuerySql)
            End If
            strBudgetQuerySql = Salary.Change_Text("[BudgetID]", mlngBudgetID, strBudgetQuerySql)
            strTmpDec = IIf(gclsBase.GetCurrencyDec("人民币") = 0, "'999,999,999,999,999,999'", "'999,999,999,999,999,990." + String(gclsBase.GetCurrencyDec("人民币"), "0")) + "'"
            strBudgetQuerySql = Salary.Change_Text("[strDec]", strTmpDec, strBudgetQuerySql)
            strTmpQuantityDec = IIf(gclsBase.QuantityDec = 0, "'999,999,999,999,999'", "'999,999,999,999,999,990." + String(gclsBase.QuantityDec, "0")) + "'"
            strBudgetQuerySql = Salary.Change_Text("[strQuantityDec]", strTmpQuantityDec, strBudgetQuerySql)
            strSql = " SELECT MIN(bytCurrencyDec) AS CurrencyDec " _
                & " FROM BudgetBalance, Currencys" _
                & " WHERE BudgetBalance.lngCurrencyID=Currencys.lngCurrencyID(+)" _
                & " AND lngBudgetID = " & mlngBudgetID
            If cboBudget.Text = "" Then
                strSql = strSql & " And intYear = 1998 "
            Else
                strSql = strSql & " And intYear =" & cboBudget.Text
            End If
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If Not recTmp.EOF Then
                If IsNull(recTmp!CurrencyDec) Then
                    strTmpCurrencyDec = "'999,999,999,999,999,990.00'"
                Else
                    If recTmp!CurrencyDec = 0 Then
                        strTmpCurrencyDec = "'999,999,999,999,999,999'"
                    Else
                        strTmpCurrencyDec = "'999,999,999,999,999,990.'" & String(recTmp!CurrencyDec, "0")
                    End If
                End If
            Else
                strTmpCurrencyDec = "'999,999,999,999,999,990.00'"
            End If
            recTmp.Close
            Set recTmp = Nothing
            strBudgetQuerySql = Salary.Change_Text("[CurrencyDec]", strTmpCurrencyDec, strBudgetQuerySql)
            Set dtaBudget.Resultset = gclsBase.BaseDB.OpenResultset(strBudgetQuerySql, rdOpenStatic)
            '原币部分
            strBudgetQuerySql = TransferPublic.getBudgetQueryOraSql(1)
            If cboBudget.Text = "" Then
                strBudgetQuerySql = Salary.Change_Text("[Year]", "1998", strBudgetQuerySql)
            Else
                strBudgetQuerySql = Salary.Change_Text("[Year]", cboBudget.Text, strBudgetQuerySql)
            End If
            strBudgetQuerySql = Salary.Change_Text("[BudgetID]", mlngBudgetID, strBudgetQuerySql)
            strBudgetQuerySql = Salary.Change_Text("[strDec]", strTmpDec, strBudgetQuerySql)
            strBudgetQuerySql = Salary.Change_Text("[strQuantityDec]", strTmpQuantityDec, strBudgetQuerySql)
            strBudgetQuerySql = Salary.Change_Text("[CurrencyDec]", strTmpCurrencyDec, strBudgetQuerySql)
            Set rec1 = gclsBase.BaseDB.OpenResultset(strBudgetQuerySql, rdOpenStatic)
            '本币部分
            strBudgetQuerySql = TransferPublic.getBudgetQueryOraSql(2)
            If cboBudget.Text = "" Then
                strBudgetQuerySql = Salary.Change_Text("[Year]", "1998", strBudgetQuerySql)
            Else
                strBudgetQuerySql = Salary.Change_Text("[Year]", cboBudget.Text, strBudgetQuerySql)
            End If
            strBudgetQuerySql = Salary.Change_Text("[BudgetID]", mlngBudgetID, strBudgetQuerySql)
            strBudgetQuerySql = Salary.Change_Text("[strDec]", strTmpDec, strBudgetQuerySql)
            strBudgetQuerySql = Salary.Change_Text("[strQuantityDec]", strTmpQuantityDec, strBudgetQuerySql)
            strBudgetQuerySql = Salary.Change_Text("[CurrencyDec]", strTmpCurrencyDec, strBudgetQuerySql)
            Set rec2 = gclsBase.BaseDB.OpenResultset(strBudgetQuerySql, rdOpenStatic)
            '数量部分
            strBudgetQuerySql = TransferPublic.getBudgetQueryOraSql(3)
            If cboBudget.Text = "" Then
                strBudgetQuerySql = Salary.Change_Text("[Year]", "1998", strBudgetQuerySql)
            Else
                strBudgetQuerySql = Salary.Change_Text("[Year]", cboBudget.Text, strBudgetQuerySql)
            End If
            strBudgetQuerySql = Salary.Change_Text("[BudgetID]", mlngBudgetID, strBudgetQuerySql)
            strBudgetQuerySql = Salary.Change_Text("[strDec]", strTmpDec, strBudgetQuerySql)
            strBudgetQuerySql = Salary.Change_Text("[strQuantityDec]", strTmpQuantityDec, strBudgetQuerySql)
            strBudgetQuerySql = Salary.Change_Text("[CurrencyDec]", strTmpCurrencyDec, strBudgetQuerySql)
            Set rec3 = gclsBase.BaseDB.OpenResultset(strBudgetQuerySql, rdOpenStatic)
            With msgBudget(1)
                intOldCols = .Cols
                .Cols = .Cols + rec1.rdoColumns.Count - 13
                Debug.Print intOldCols, rec1.rdoColumns.Count, .Cols
                For j = intOldCols To intOldCols + rec1.rdoColumns.Count - 14
                    .TextMatrix(0, j) = rec1.rdoColumns(j - intOldCols).Name
                Next
                If Not rec1.EOF Then
                    rec1.MoveLast
                    rec1.MoveFirst
                    For i = 0 To rec1.RowCount - 1
                        For j = intOldCols To intOldCols + rec1.rdoColumns.Count - 14
                            If rec1.rdoColumns(j - intOldCols).Value = 0 Then
                                .TextMatrix(i + 1, j) = ""
                            Else
                                .TextMatrix(i + 1, j) = Format(rec1.rdoColumns(j - intOldCols).Value, rec1!strFormat)
                            End If
                        Next
                        rec1.MoveNext
                    Next
                End If
                intOldCols = .Cols
                .Cols = .Cols + rec2.rdoColumns.Count - 12
                Debug.Print intOldCols, rec2.rdoColumns.Count, .Cols
                For j = intOldCols To intOldCols + rec2.rdoColumns.Count - 13
                    .TextMatrix(0, j) = rec2.rdoColumns(j - intOldCols).Name
                Next
                If Not rec2.EOF Then
                    rec2.MoveLast
                    rec2.MoveFirst
                    For i = 0 To rec2.RowCount - 1
                        For j = intOldCols To intOldCols + rec2.rdoColumns.Count - 13
                            .TextMatrix(i + 1, j) = IIf(IsNull(rec2.rdoColumns(j - intOldCols).Value), "", rec2.rdoColumns(j - intOldCols).Value)
                        Next
                        rec2.MoveNext
                    Next
                End If
                intOldCols = .Cols
                .Cols = .Cols + rec3.rdoColumns.Count - 12
                Debug.Print intOldCols, rec3.rdoColumns.Count, .Cols
                For j = intOldCols To intOldCols + rec3.rdoColumns.Count - 13
                    .TextMatrix(0, j) = rec3.rdoColumns(j - intOldCols).Name
                Next
                If Not rec3.EOF Then
                    rec3.MoveLast
                    rec3.MoveFirst
                    For i = 0 To rec3.RowCount - 1
                        For j = intOldCols To intOldCols + rec3.rdoColumns.Count - 13
                            .TextMatrix(i + 1, j) = IIf(IsNull(rec3.rdoColumns(j - intOldCols).Value), "", rec3.rdoColumns(j - intOldCols).Value)
                        Next