frmexpenseamount.frm

金算盘软件代码

                        End If
                    Next
                    recRecordset.MoveNext
                Next
                txtShare1Set             '待分摊费用，已分摊费用设置
            End With
        Else
            ShowMsg msgProcurementChange.hWnd, "没有符合条件选择的采购商品记录。", vbInformation, Me.Caption   '显示对话框
        End If
        recRecordset.Close
        Set recRecordset = Nothing
    End If
End Sub

'筛选
Private Sub Filt_Click()
    Dim intCol As Integer
    Dim blnTmp As Boolean
    Dim blnSave As Boolean
    Dim i As Integer
    Dim lngYESNO As Long
    
    If mintIsListActivate <> 1 And mintIsListActivate <> 2 Then
        mintIsListActivate = 1
    End If
    If mintIsListActivate = 1 Then
        blnSave = False
        With msgProcurementCost
            For i = 1 To .Rows - 1
                If .TextMatrix(i, 1) = "√" Then
                    blnSave = True
                    Exit For
                End If
            Next
        End With
        If blnSave Then
            lngYESNO = ShowMsg(Me.hWnd, "筛选将取消已选择的采购费用，是否继续？", vbQuestion + vbDefaultButton2 + vbYesNo, Me.Caption)
            If lngYESNO = vbNo Then
                Exit Sub
            End If
            With msgProcurementCost
                For i = 1 To .Rows - 1
                    .TextMatrix(i, 1) = ""
                Next
            End With
        End If
        mclsProcurementCostGrid.ListSet.SaveList
        Filter.ShowFilter mclsProcurementCostGrid.ListSet.ListID, 1, , , , , blnTmp
        If blnTmp Then                 '按确定返回
            mclsProcurementCostGrid.ListSet.SaveList
            mclsProcurementCostGrid.ListSet.ViewId = mintProcurementCostViewID
            GetProcurementCostList mintProcurementCostViewID
            mblnArrIsFilter(0) = False
            mclsProcurementCostGrid.ListSetToGrid
            mclsProcurementCostGrid.SetupStyle
            intCol = GetColNO(msgProcurementCost, "采购单号", mintProcurementCostViewID)
            mclsProcurementCostGrid.ColSort(intCol) = True
            mclsProcurementCostGrid.Sort intCol, 1
            CalDate_LostFocus
            mclsProcurementCostGrid.Grid.Refresh
        End If
        On Error Resume Next
        msgProcurementCost.SetFocus
        On Error GoTo 0
    End If
    If mintIsListActivate = 2 Then
        blnSave = False
        With msgProcurementChange
            For i = 1 To .Rows - 1
                If .TextMatrix(i, 1) = "√" Then
                    blnSave = True
                    Exit For
                End If
            Next
        End With
        If blnSave Then
            lngYESNO = ShowMsg(Me.hWnd, "筛选将取消已选择的采购商品，是否继续？", vbQuestion + vbDefaultButton2 + vbYesNo, Me.Caption)
            If lngYESNO = vbNo Then
                Exit Sub
            End If
            With msgProcurementChange
                For i = 1 To .Rows - 1
                    .TextMatrix(i, 1) = ""
                Next
            End With
        End If
        mclsProcurementChangeGrid.ListSet.SaveList
        Filter.ShowFilter mclsProcurementChangeGrid.ListSet.ListID, 1, , , , , blnTmp
        If blnTmp Then         '按确定返回
            mclsProcurementChangeGrid.ListSet.SaveList
            mclsProcurementChangeGrid.ListSet.ViewId = mintProcurementChangeViewId
            GetProcurementChangeList mintProcurementChangeViewId
            mblnArrIsFilter(1) = False
            mclsProcurementChangeGrid.ListSetToGrid
            mclsProcurementChangeGrid.SetupStyle
            intCol = GetColNO(msgProcurementChange, "采购单号", mintProcurementChangeViewId)
            mclsProcurementChangeGrid.ColSort(intCol) = True
            mclsProcurementChangeGrid.Sort intCol, 1
            CalDate_LostFocus
            mclsProcurementChangeGrid.Grid.Refresh
        End If
        On Error Resume Next
        msgProcurementChange.SetFocus
        On Error GoTo 0
    End If
    chkCmdArrSelectEnabled       '全部选择，全部取消，条件选择，关联命令按钮的状态
    UpdateMenuStatus    '设置菜单可用属性
End Sub

'取消费用分摊
Private Sub NoCostToShare_Click()
    Dim intCount As Integer
    Dim intCol As Integer

    intCol = GetColNO(msgProcurementChange, "本次分摊费用", mintProcurementChangeViewId)
    With msgProcurementChange
        For intCount = 1 To .Rows - 1
            .TextMatrix(intCount, 1) = ""
            .TextMatrix(intCount, intCol) = ""
        Next
    End With
    intCol = GetColNO(msgProcurementCost, "本次分摊费用", mintProcurementCostViewID)
    With msgProcurementCost
        For intCount = 1 To .Rows - 1
            .TextMatrix(intCount, 1) = ""
            .TextMatrix(intCount, intCol) = ""
        Next
    End With
    txtShare1Set
    cmdArr(1).SetFocus
End Sub

'栏目设置
Private Sub RailSet_Click()
    Dim blnTmp As Boolean
    Dim intCol As Integer
    Dim blnSave As Boolean
    Dim i As Integer
    Dim j As Integer
    Dim lngYESNO As Long
    Dim lngSeID() As Long
    Dim strSeflag() As String
    Dim dblMoney() As Double
    
    If mintIsListActivate <> 1 And mintIsListActivate <> 2 Then
        mintIsListActivate = 1
    End If
    If mintIsListActivate = 1 Then
        blnSave = False
        With msgProcurementCost
            For i = 1 To .Rows - 1
                If .TextMatrix(i, 1) = "√" Then
                    blnSave = True
                    Exit For
                End If
            Next
        End With
        If blnSave Then
            lngYESNO = ShowMsg(Me.hWnd, "栏目设置将取消已选择的采购费用，是否保存？", vbQuestion + vbDefaultButton2 + vbYesNo, Me.Caption)
            If lngYESNO = vbYes Then
                intCol = GetColNO(msgProcurementCost, "本次分摊费用", mintProcurementCostViewID)
                With msgProcurementCost
                    ReDim lngSeID(.Rows - 2)
                    ReDim strSeflag(.Rows - 2)
                    ReDim dblMoney(.Rows - 2)
                    For i = 1 To .Rows - 1
                        If .TextMatrix(i, 1) = "√" Then
                            lngSeID(i - 1) = .TextMatrix(i, 0)
                            strSeflag(i - 1) = "√"
                            If Trim(.TextMatrix(i, intCol)) <> "" Then
                                dblMoney(i - 1) = CDbl(.TextMatrix(i, intCol))
                            Else
                                dblMoney(i - 1) = 0
                            End If
                        Else
                            lngSeID(i - 1) = 0
                            strSeflag(i - 1) = ""
                            dblMoney(i - 1) = 0
                        End If
                    Next
                End With
            Else
                With msgProcurementCost
                    For i = 1 To .Rows - 1
                       .TextMatrix(i, 1) = ""
                    Next
                End With
            End If
        End If
        mclsProcurementCostGrid.ListSet.SaveList
        intCol = GetColNO(msgProcurementCost, "采购单号", mintProcurementCostViewID)      '将排序列设在必选选列上
        mclsProcurementCostGrid.ColSort(intCol) = True
        mclsProcurementCostGrid.Sort intCol, 1
        blnTmp = mclsProcurementCostGrid.ListSet.ShowListSet(mintProcurementCostViewID)
        If blnTmp Then
            mclsProcurementCostGrid.ListSet.SaveList
            mclsProcurementCostGrid.ListSet.ViewId = mintProcurementCostViewID
            GetProcurementCostList mintProcurementCostViewID
            mclsProcurementCostGrid.ListSetToGrid
            mclsProcurementCostGrid.SetupStyle
            intCol = GetColNO(msgProcurementCost, "采购单号", mintProcurementCostViewID)    '默认排序列
            mclsProcurementCostGrid.ColSort(intCol) = True
            mclsProcurementCostGrid.Sort intCol, 1
            CalDate_LostFocus
            msgProcurementCost.Refresh
            If lngYESNO = vbYes Then
                intCol = GetColNO(msgProcurementCost, "本次分摊费用", mintProcurementCostViewID)
                With msgProcurementCost
                    For i = 1 To .Rows - 1
                        For j = 0 To UBound(lngSeID)
                            If lngSeID(j) > 0 Then
                                If .TextMatrix(i, 0) = lngSeID(j) Then
                                    .TextMatrix(i, 1) = "√"
                                    .TextMatrix(i, intCol) = IIf(dblMoney(j) = 0, "", Format(dblMoney(j), "0.00"))
                                    Exit For
                                End If
                            End If
                        Next
                    Next
                End With
                txtShare1Set
            End If
        End If
        On Error Resume Next
        msgProcurementCost.SetFocus
        On Error GoTo 0
    End If
    If mintIsListActivate = 2 Then
        blnSave = False
        With msgProcurementChange
            For i = 1 To .Rows - 1
                If .TextMatrix(i, 1) = "√" Then
                    blnSave = True
                    Exit For
                End If
            Next
        End With
        If blnSave Then
            lngYESNO = ShowMsg(Me.hWnd, "栏目设置将取消已选择的采购商品，是否保存？", vbQuestion + vbDefaultButton2 + vbYesNo, Me.Caption)
            If lngYESNO = vbYes Then
                intCol = GetColNO(msgProcurementChange, "本次分摊费用", mintProcurementChangeViewId)
                With msgProcurementChange
                    ReDim lngSeID(.Rows - 2)
                    ReDim strSeflag(.Rows - 2)
                    ReDim dblMoney(.Rows - 2)
                    For i = 1 To .Rows - 1
                        If .TextMatrix(i, 1) = "√" Then
                            lngSeID(i - 1) = .TextMatrix(i, 0)
                            strSeflag(i - 1) = "√"
                            If Trim(.TextMatrix(i, intCol)) <> "" Then
                                dblMoney(i - 1) = .TextMatrix(i, intCol)
                            Else
                                dblMoney(i - 1) = 0
                            End If
                        Else
                            lngSeID(i - 1) = 0
                            strSeflag(i - 1) = ""
                            dblMoney(i - 1) = 0
                        End If
                    Next
                End With
            Else
                With msgProcurementChange
                    For i = 1 To .Rows - 1
                       .TextMatrix(i, 1) = ""
                    Next
                End With
            End If
        End If
        mclsProcurementChangeGrid.ListSet.SaveList
        intCol = GetColNO(msgProcurementChange, "采购单号", mintProcurementChangeViewId)
        mclsProcurementChangeGrid.ColSort(intCol) = True
        mclsProcurementChangeGrid.Sort intCol, 1
        blnTmp = mclsProcurementChangeGrid.ListSet.ShowListSet(mintProcurementChangeViewId)
        If blnTmp Then
            mclsProcurementChangeGrid.ListSet.SaveList
            mclsProcurementChangeGrid.ListSet.ViewId = mintProcurementChangeViewId
            GetProcurementChangeList mintProcurementChangeViewId
            mclsProcurementChangeGrid.ListSetToGrid
            mclsProcurementChangeGrid.SetupStyle
            intCol = GetColNO(msgProcurementChange, "采购单号", mintProcurementChangeViewId)
            mclsProcurementChangeGrid.ColSort(intCol) = True
            mclsProcurementChangeGrid.Sort intCol, 1
            CalDate_LostFocus
            msgProcurementChange.Refresh
            If lngYESNO = vbYes Then
                intCol = GetColNO(msgProcurementChange, "本次分摊费用", mintProcurementChangeViewId)
                With msgProcurementChange
                    For i = 1 To .Rows - 1
                        For j = 0 To UBound(lngSeID)
                            If lngSeID(j) > 0 Then
                                If .TextMatrix(i, 0) = lngSeID(j) Then
                                    .TextMatrix(i, 1) = "√"
                                    .TextMatrix(i, intCol) = IIf(dblMoney(j) = 0, "", Format(dblMoney(j), "0.00"))
                                    Exit For
                                End If
                            End If
                        Next
                    Next
                End With
                txtShare1Set
            End If
        End If
        On Error Resume Next
        msgProcurementChange.SetFocus
        On Error GoTo 0
    End If
    UpdateMenuStatus    '设置菜单可用属性
End Sub