frmaccountfixedasset.frm

金算盘软件代码

    Dim intYear As Integer
    Dim strCaption As String
    
    On Error Resume Next
    mintAction = intIndex
    
    With frmMain
        For lngCnt = .mnuListEditMenu.Count - 1 To 1 Step -1
            Unload .mnuListEditMenu(lngCnt)
        Next lngCnt
    End With
    
    Select Case tabList.TabCaption(tabList.Tab)
        Case "变动资料(&Z)"
            Select Case intIndex
                Case 5
                    '删除固资变动
                    If ExclusiveIn("计提折旧", 0, "您现在不能删除固定资产资料，以下用户正在计提折旧：") Then
                        If DeleteFix() Then
                            If msgGrid.Rows = 2 Then
                                RefreshAlterGrid
                            Else
                                msgGrid.RemoveItem msgGrid.Row
                            End If
                        End If
                    End If
                Case 6
                    '复制
                    If ExclusiveIn("计提折旧", 0, "您现在不能删除固定资产资料，以下用户正在计提折旧：") Then
                        CopyCard
                    End If
                Case 8
                    '卡片查阅
                    Me.MousePointer = vbHourglass
                    With frmScanFixCard
                        .EditCard GetValue(msgGrid.Row, GetGridCol("lngFixedCardID", msgGrid))
                    End With
                    Me.MousePointer = vbDefault
                Case 10
                    '筛选
                    SelWithFilter
                Case 11
                    '栏目设置
                    If mclsList.ListSet.ShowListSet(ViewID_Alter) Then
                        RefreshAlterGrid
                        chkShowAll_Click
                    End If
                Case 13
                    '刷新
                    RefreshAlterGrid
                Case 15
                    '打印
                    mclsList.ClearSortColArrow
                    clsPrint.PrintList gclsBase.BaseDB, msgGrid, _
                    12, "固定资产变动资料列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
                    mclsList.AddSortColArrow
                Case 14
                    '打印单据
                    mclsMainControl_FilePrintReceipt
            End Select
        Case "工作量(&W)"
            Select Case intIndex
                Case 0
                    If ExclusiveIn("计提折旧", 0, "您现在不能复制工作量，以下用户正在计提折旧：") Then
                        '复制工作量
                        strDate = GetValue(msgGrid.Row, GetGridCol("会计期间", msgGrid), "String")
                        bytPeriod = CInt(Mid$(strDate, 6, 2))
                        intYear = CInt(Mid$(strDate, 1, 4))
                        If GetGridCol("本期工作量", msgGrid) > 0 Then
                            If Not PeriodDepection(intYear, bytPeriod, 0, False) Then
                                strSql = "SELECT lngFixedCardID FROM FixedBalance WHERE dblWork>0 AND intYear*100+bytPeriod<>" & CLng(intYear) * 100 + bytPeriod
                                Set recCard = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                                If Not recCard.EOF Then
                                    msgGrid.col = GetGridCol("本期工作量", msgGrid)
                                    frmCopyWork.CopyWork msgGrid, 0, msgGrid.col
                                    msgGrid.Redraw = False
                                    For lngRow = 1 To msgGrid.Rows - 1
                                        msgGrid.Row = lngRow
                                        mclsList_AfterSave
                                    Next lngRow
                                    msgGrid.Redraw = True
                                    msgGrid.Row = 1
                                Else
                                    ShowMsg hwnd, "没有工作量可以复制！", vbExclamation, Me.Caption
                                End If
                                recCard.Close
                                Set recCard = Nothing
                            Else
                                ShowMsg hwnd, intYear & "." & bytPeriod & "期(或以后期间)数据已提折旧，不能复制本月工作量！", vbExclamation, Me.Caption
                            End If
                        End If
                    End If
                Case 2
                    '全部清除
                    If ExclusiveIn("计提折旧", 0, "您现在不能清除工作量，以下用户正在计提折旧：") Then
                        bytPeriod = C2lng(Right(GetValue(msgGrid.Row, GetGridCol("会计期间", msgGrid), "String"), 2))
                        intYear = C2lng(Left(GetValue(msgGrid.Row, GetGridCol("会计期间", msgGrid), "String"), 4))
                        If gclsBase.PeriodIsClosed(intYear, bytPeriod) Then
                            ShowMsg hwnd, intYear & "." & bytPeriod & "期已结帐，不能清除本期工作量！", vbExclamation, Me.Caption
                            Exit Sub
                        End If
                        If PeriodDepection(intYear, bytPeriod, 0, False) Then
                            ShowMsg hwnd, intYear & "." & bytPeriod & "期(或以后期间)数据已提折旧，不能清除本月工作量！", vbExclamation, Me.Caption
                            Exit Sub
                        End If
                        If ShowMsg(hwnd, "您是否确定要清除本月工作量？", vbQuestion + vbYesNo + vbDefaultButton2, Caption) = vbYes Then
                            With msgGrid
                                lngColumn = GetGridCol("本期工作量", msgGrid)
                                For lngRow = 1 To .Rows - 1
                                    .TextMatrix(lngRow, lngColumn) = ""
                                    strSql = "UPDATE FixedBalance SET dblWork=0 WHERE lngFixedCardID=" & GetValue(lngRow, 0) _
                                        & " AND intYear=" & intYear & " AND bytPeriod=" & bytPeriod
                                    gclsBase.ExecSQL strSql
                                Next lngRow
                            End With
                        End If
                    End If
                Case 4
                    '筛选
                    SelWithFilter
                Case 5
                    '栏目设置
                    If mclsList.ListSet.ShowListSet(ViewID_Work, False) Then
                        RefreshWorkGrid
                    End If
                Case 7
                    '刷新
                     RefreshWorkGrid
                Case 8
                    '打印
                    mclsList.ClearSortColArrow
                    clsPrint.PrintList gclsBase.BaseDB, msgGrid, _
                    13, "固定资产工作量资料列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
                    mclsList.AddSortColArrow
            End Select
            
        Case "固资卡片(&D)"
            Select Case intIndex
                Case 0
                    '卡片查阅
                    Me.MousePointer = vbHourglass
                    With frmScanFixCard
                        .EditCard GetValue(msgGrid.Row, GetGridCol("lngFixedCardID", msgGrid))
                    End With
                    Me.MousePointer = vbDefault
                    
                Case 2
                    '筛选
                    SelWithFilter
                    
                Case 3
                    '栏目设置
                    If mclsList.ListSet.ShowListSet(ViewID_Card) Then
                        RefreshCardGrid
                    End If
                Case 5
                    '刷新
                    RefreshCardGrid
                Case 7
                    '打印
                    mclsList.ClearSortColArrow
                    clsPrint.PrintList gclsBase.BaseDB, msgGrid, _
                    14, "固定资产卡片资料列表" & Chr(1) & gclsBase.BaseName & Chr(1) & gclsBase.OperatorName
                    mclsList.AddSortColArrow
                Case 6
                    '打印单据
                    mclsMainControl_FilePrintReceipt
            End Select
    End Select
    
    Set clsPrint = Nothing
End Sub

Private Sub AfterListEdit(intIndex As Integer)
    If tabList.TabCaption(tabList.Tab) = "变动资料(&Z)" Then
        If ExclusiveIn("计提折旧", 0, "您现在不能编辑固定资产资料，以下用户正在计提折旧：") Then
            Select Case intIndex
            Case 0
                '增加固资
                Me.MousePointer = vbHourglass
                frmFixedAdd.AddNew
                Me.MousePointer = vbDefault
                Form_Activate
            Case 1
                '减少固资
                Me.MousePointer = vbHourglass
                Set frmFixedDec = Nothing
                frmFixedDec.AddNew
                Me.MousePointer = vbDefault
                Form_Activate
            Case 2
                '其它变动
                Me.MousePointer = vbHourglass
                Set frmFixedOtherAlter = Nothing
                frmFixedOtherAlter.AddNew
                Me.MousePointer = vbDefault
                Form_Activate
            Case 4
                '修改
                msgGrid_DblClick
            End Select
        End If
    End If
    intIndex = -1
End Sub

Private Sub mclsMainControl_ListReportMenu(ByVal intIndex As Integer)
    Select Case intIndex
    Case 0 '固定资产清单
        Report.ShowStandardReport 1635, 754
    Case 1 '固定资产汇总表
        Report.ShowSumReport 1636, 755
    Case 2 '固定资产变动情况明细表
        Report.ShowStandardReport 1638, 757
    Case 3 '固定资产折旧计算表
        Report.ShowSumReport 1456, 667
    Case 4 '固定资产帐
        Report.ShowAcntBook 1372, 598
    End Select
End Sub

'根据所选ssTab页面做相应的处理
Private Sub tabList_Click(PreviousTab As Integer)
    If Not mclsList Is Nothing Then
        If mclsList.ListSet.ListID = 0 Then
            mclsList.GridToListSet
            mclsList.ListSet.SaveList
        End If
    End If
    
    Select Case tabList.TabCaption(tabList.Tab)
    Case "变动资料(&Z)"
        RefreshAlterGrid
        chkShowAll_Click
        RefreshMenu
    Case "工作量(&W)"
        RefreshWorkGrid
        chkShowAll.Enabled = False
        RefreshMenu
    Case "固资卡片(&D)"
        RefreshCardGrid
        chkShowAll.Enabled = False
        RefreshMenu
    End Select
End Sub

'返回用于填充固资工作量列表的记录集
Private Function GetWorkAmountList() As rdoResultset
    Dim strSql As String
    Dim strQFixedMaxWork As String
    Dim strSelectOfSql As String
    Dim strFromOfSql As String
    Dim strWhereOfSql As String
    
'    On Error Resume Next
    
    strQFixedMaxWork = "(SELECT FixedBalance.lngFixedCardID, MAX(FixedBalance.intYear*100+FixedBalance.bytPeriod) AS MaxPeriod " _
        & "FROM FixedBalance,FixedCard,FixedAlter " _
        & "WHERE FixedCard.lngRecentFixedAlterID=FixedAlter.lngFixedAlterID " _
        & "AND FixedBalance.lngFixedCardID=FixedCard.lngFixedCardID " _
        & "AND FixedBalance.intYear * 100+FixedBalance.bytPeriod<=" & CLng(gclsBase.AccountYear) * 100 + gclsBase.Period _
        & " And (FixedBalance.dblDeprection<>0 Or FixedBalance.dblWork<>0 Or FixedAlter.intYear * 100 + FixedAlter.bytPeriod >= FixedBalance.intYear * 100 + FixedBalance.bytPeriod) " _
        & "GROUP BY FixedBalance.lngFixedCardID) QFixedMaxWork "
    
    With mclsList.ListSet
        strSelectOfSql = "SELECT FixedCard.lngFixedCardID," & .SelectOfSql
        strSelectOfSql = Replace(strSelectOfSql, "[PERIOD]", "'" & gclsBase.AccountYear & "." & Format(gclsBase.Period, "00") & "'")
        strSelectOfSql = Replace(strSelectOfSql, "[LNGPERIOD]", CLng(gclsBase.AccountYear) * 100 + gclsBase.Period & "")
        strFromOfSql = .FromOfSql
        strFromOfSql = Replace(strFromOfSql, "[QFIXEDMAXWORK]", strQFixedMaxWork)
        strWhereOfSql = .WhereOfSql
    End With
    If strWhereOfSql <> "" Then
        strWhereOfSql = "WHERE " & strWhereOfSql & " AND (FixedAlter.strDepreciationMethod='3' AND (FixedAlter.blnIsVoid=0)"
    Else
        strWhereOfSql = "WHERE (FixedAlter.strDepreciationMethod='3' AND (FixedAlter.blnIsVoid=0)"
    End If
    strWhereOfSql = strWhereOfSql & " AND (FixedAlter.intYear*100+FixedAlter.bytPeriod<" _
        & CLng(gclsBase.AccountYear) * 100 + gclsBase.Period & " OR FixedAlter.blnIsInit=1) " _
        & "AND (FixedAlter.strFixedState='1' OR FixedAlter.strFixedState='4') AND FixedAlter.bytAlterType<>2 " _
        & "OR FixedBalance.dblWork>0 AND FixedBalance.intYear=" & gclsBase.AccountYear & " AND FixedBalance.bytPeriod=" & gclsBase.Period & ")"
    ' AND FixedBalance.intYear=" & gclsBase.AccountYear & " AND FixedBalance.bytPeriod=" & gclsBase.Period
    strSql = strSelectOfSql & " " & strFromOfSql & " " & strWhereOfSql
    Set GetWorkAmountList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If GetWorkAmountList.EOF Then
        cmdSeekAgain.Enabled = False
    Else
        cmdSeekAgain.Enabled = True
    End If
End Function

'返回用于填充固定资产变动资料列表的记录集
Private Function GetFixedAlterList() As rdoResultset
    Dim strSql As String
    Dim strSelectOfSql As String
    Dim strFromOfSql As String
    Dim strWhereOfSql As String
    
    mclsList.FormatData = False
    If mclsList.ListSet.ListID = 0 Then
        mclsList.ListSet.SaveList
        DefaultCurrentDate mclsList.ListSet.ListID, 1873
        mclsList.ListSet.ViewId = ViewID_Alter
    End If
    With mclsList.ListSet
        strSelectOfSql = "SELECT DECODE(FixedAlter.blnIsVoid,1,'√','') As 作废," _
            & "FixedAlter.lngFixedAlterID,FixedAlter.lngFixedCardID,FixedAlter.bytAlterType," & .SelectOfSql
        strFromOfSql = .FromOfSql
        strWhereOfSql = .WhereOfSql
        If strWhereOfSql = "" Then
            strWhereOfSql = "1=1"
        End If
    End With
    strWhereOfSql = " WHERE " & strWhereOfSql
    strWhereOfSql = strWhereOfSql & " AND TO_DATE(FixedAlter.strDate,'YYYY-MM-DD')>=TO_DATE('" & Format(gclsBase.BeginDate, "yyyy-mm-dd") & "','YYYY-MM-DD')"
    strSql = strSelectOfSql & strFromOfSql & strWhereOfSql

    Set GetFixedAlterList = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic, rdConcurValues)
    
    If GetFixedAlterList.EOF Then
        cmdSeekAgain.Enabled = False
        chkShowAll.Enabled = False
    Else
        cmdSeekAgain.Enabled = True
        If tabList.Tab = 0 Then
            GetFixedAlterList.MoveFirst
'            Do While Not GetFixedAlterList.EOF
'                If GetFixedAlterList("作废") = "√" Then Exit Do
'                GetFixedAlterList.MoveNext
'            Loop
            chkShowAll.Enabled = Not GetFixedAlterList.EOF
        Else
            chkShowAll.Enabled = False
        End If
    End If
End Function