costtoshare.frm

金算盘软件代码

        End If
        recRecordset.Close
        Set recRecordset = Nothing
    End If
    
    If mintIsListActivate = 3 Then
        With mclsAddCostGrid.ListSet
            strSelectOfSql = "select AddCostQuery.ID as ID,'' as 选取," & .SelectOfSql
            strFromOfSql = .FromOfSql
            strWhereOfSql = .WhereOfSql
        End With
        Strsql = strSelectOfSql & strFromOfSql
        strWhereOfSql = Trim(strWhereOfSql)
        If strWhereOfSql <> "" Then
            Strsql = Strsql & " Where  " & strWhereOfSql
        End If
        Set recRecordset = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
        If Not recRecordset.EOF Then
            recRecordset.MoveLast
            recRecordset.MoveFirst
            intCol1 = GetColNO(msgAddCost, "本次分摊费用")
            intCol2 = GetColNO(msgAddCost, "未分摊费用")
            With msgAddCost
                For intCount1 = 1 To .Rows - 1
                    .TextMatrix(intCount1, 1) = ""       '清除选择费用项目标志
                    .TextMatrix(intCount1, intCol1) = 0
                Next
                blnTmp = False
                For intCount1 = 0 To recRecordset.RowCount - 1
                    lngTmpID = recRecordset!ID
                    For intCount2 = 1 To .Rows - 1
                        If .RowHeight(intCount2) <> 0 Then
                            If .TextMatrix(intCount2, 0) = lngTmpID Then
                                .TextMatrix(intCount2, 1) = "√"     '选择费用项目打上标志
                                .TextMatrix(intCount2, intCol1) = .TextMatrix(intCount2, intCol2)
                                blnTmp = True
                            End If
                        End If
                    Next
                    recRecordset.MoveNext
                Next
                txtShare2Set        '待分摊费用，已分摊费用设置
            End With
            If Not blnTmp Then
               ShowMsg msgAddCost.hwnd, "没有符合条件选择的加工费用记录。", vbInformation, Me.Caption
            End If
        Else
            ShowMsg msgAddCost.hwnd, "没有符合条件选择的加工费用记录。", vbInformation, Me.Caption   '显示对话框
        End If
        recRecordset.Close
        Set recRecordset = Nothing
    End If
    
    If mintIsListActivate = 4 Then
        With mclsAddChangeGrid.ListSet
            strSelectOfSql = "select AddChangeQuery.ID as ID,'' as 选取," & .SelectOfSql
            strFromOfSql = .FromOfSql
            strWhereOfSql = .WhereOfSql
        End With
        Strsql = strSelectOfSql & strFromOfSql
        strWhereOfSql = Trim(strWhereOfSql)
        If strWhereOfSql <> "" Then
            Strsql = Strsql & "  Where  " & strWhereOfSql
        End If
        Set recRecordset = gclsBase.BaseDB.OpenRecordset(Strsql, dbOpenSnapshot)
        If Not recRecordset.EOF Then
            recRecordset.MoveLast
            recRecordset.MoveFirst
            intCol1 = GetColNO(msgAddChange, "本次分摊费用")
            With msgAddChange
                For intCount1 = 1 To .Rows - 1
                    .TextMatrix(intCount1, 1) = ""       '清除选择商品项目标志
                    .TextMatrix(intCount1, intCol1) = 0
                Next
                blnTmp = False
                For intCount1 = 0 To recRecordset.RowCount - 1
                    lngTmpID = recRecordset!ID
                    For intCount2 = 1 To .Rows - 1
                        If .RowHeight(intCount2) <> 0 Then
                            If .TextMatrix(intCount2, 0) = lngTmpID Then
                                .TextMatrix(intCount2, 1) = "√"     '选择商品项目打上标志
                                blnTmp = True
                            End If
                        End If
                    Next
                    recRecordset.MoveNext
                Next
                txtShare2Set         '待分摊费用，已分摊费用设置
            End With
            If Not blnTmp Then
               ShowMsg msgAddChange.hwnd, "没有符合条件选择的加工商品记录。", vbInformation, Me.Caption
            End If
        Else
            ShowMsg msgAddChange.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
    
    If mintIsListActivate = 1 Then
        mclsProcurementCostGrid.ListSet.SaveList
        Filter.ShowFilter mclsProcurementCostGrid.ListSet.ListID, 1, , , , , blnTmp
        If blnTmp Then                 '按确定返回
            mclsProcurementCostGrid.ListSet.SaveList
            mclsProcurementCostGrid.ListSet.ViewId = mintProcurementCostViewID
            GetProcurementCostList mintProcurementCostViewID, False
            mblnArrIsFilter(0) = False
            mclsProcurementCostGrid.ListSetToGrid
            mclsProcurementCostGrid.SetupStyle
            intCol = GetColNO(msgProcurementCost, "单据号")
            mclsProcurementCostGrid.ColSort(intCol) = True
            mclsProcurementCostGrid.Sort intCol, 1
            mclsProcurementCostGrid.Grid.Refresh
            If Not mblnIsProcurementCostEmpoty Then
                ShowMsg msgProcurementCost.hwnd, "没有采购费用列表记录！", vbExclamation, Me.Caption
            End If
        End If
    End If
    If mintIsListActivate = 2 Then
        mclsProcurementChangeGrid.ListSet.SaveList
        Filter.ShowFilter mclsProcurementChangeGrid.ListSet.ListID, 1, , , , , blnTmp
        If blnTmp Then         '按确定返回
            mclsProcurementChangeGrid.ListSet.SaveList
            mclsProcurementChangeGrid.ListSet.ViewId = mintProcurementChangeViewId
            GetProcurementChangeList mintProcurementChangeViewId, False
            mblnArrIsFilter(1) = False
            mclsProcurementChangeGrid.ListSetToGrid
            mclsProcurementChangeGrid.SetupStyle
            intCol = GetColNO(msgProcurementChange, "单据号")
            mclsProcurementChangeGrid.ColSort(intCol) = True
            mclsProcurementChangeGrid.Sort intCol, 1
            mclsProcurementChangeGrid.Grid.Refresh
            If Not mblnIsProcurementChangeEmpoty Then
                ShowMsg msgProcurementChange.hwnd, "没有采购商品列表记录！", vbExclamation, Me.Caption
            End If
        End If
    End If
    If mintIsListActivate = 3 Then
        mclsAddCostGrid.ListSet.SaveList
        Filter.ShowFilter mclsAddCostGrid.ListSet.ListID, 1, , , , , blnTmp    '调用筛选
        If blnTmp Then            '按确定返回
            mclsAddCostGrid.ListSet.SaveList
            mclsAddCostGrid.ListSet.ViewId = mintAddCostViewID
            GetAddCostList mintAddCostViewID, False     '设置列表记录集
            mblnArrIsFilter(2) = False
            mclsAddCostGrid.ListSetToGrid
            mclsAddCostGrid.SetupStyle
            intCol = GetColNO(msgAddCost, "单据号")
            mclsAddCostGrid.ColSort(intCol) = True         '设置列表排序列
            mclsAddCostGrid.Sort intCol, 1                 '升序排列
            mclsAddCostGrid.Grid.Refresh
            If Not mblnIsAddCostEmpoty Then
                ShowMsg msgAddCost.hwnd, "没有加工费用列表记录！", vbExclamation, Me.Caption  '显示对话框
            End If
        End If
    End If
    If mintIsListActivate = 4 Then
        mclsAddChangeGrid.ListSet.SaveList
        Filter.ShowFilter mclsAddChangeGrid.ListSet.ListID, 1, , , , , blnTmp
        If blnTmp Then        '按确定返回
            mclsAddChangeGrid.ListSet.SaveList
            mclsAddChangeGrid.ListSet.ViewId = mintAddChangeViewID
            GetAddChangeList mintAddChangeViewID, False
            mblnArrIsFilter(3) = False
            mclsAddChangeGrid.ListSetToGrid
            mclsAddChangeGrid.SetupStyle
            intCol = GetColNO(msgAddChange, "单据号")
            mclsAddChangeGrid.ColSort(intCol) = True
            mclsAddChangeGrid.Sort intCol, 1
            mclsAddChangeGrid.Grid.Refresh
            If Not mblnIsAddChangeEmpoty Then
                ShowMsg msgAddChange.hwnd, "没有加工商品列表记录！", vbExclamation, Me.Caption
            End If
        End If
    End If
    chkCmdArrSelectEnabled       '全部选择，全部取消，条件选择，关联命令按钮的状态
    UpdateMenuStatus    '设置菜单可用属性
End Sub

'取消费用分摊
Private Sub NoCostToShare_Click()
    Dim intCount As Integer
    Dim intCol As Integer
    Dim dblTmp As Double
    
    If SSTab1.Tab = 0 Then
        intCol = GetColNO(msgProcurementChange, "本次分摊费用")
        With msgProcurementChange
            For intCount = 1 To .Rows - 1
                .TextMatrix(intCount, 1) = ""
                .TextMatrix(intCount, intCol) = "0"
            Next
        End With
        intCol = GetColNO(msgProcurementCost, "本次分摊费用")
        With msgProcurementCost
            For intCount = 1 To .Rows - 1
                If .TextMatrix(intCount, 1) = "√" Then
                    dblTmp = dblTmp + .TextMatrix(intCount, intCol)
                End If
            Next
        End With
        lblShare(0).Caption = "待分摊费用："
        lblShare(0).Caption = lblShare(0).Caption & dblTmp & "  - 已分摊费用：0"
        lblShare(0).Caption = lblShare(0).Caption & " = " & dblTmp
    End If
    If SSTab1.Tab = 1 Then
        intCol = GetColNO(msgAddChange, "本次分摊费用")
        With msgAddChange
            For intCount = 1 To .Rows - 1
                .TextMatrix(intCount, 1) = ""
                .TextMatrix(intCount, intCol) = "0"
            Next
        End With
        intCol = GetColNO(msgAddCost, "本次分摊费用")
        With msgAddCost
            For intCount = 1 To .Rows - 1
                If .TextMatrix(intCount, 1) = "√" Then
                    dblTmp = dblTmp + .TextMatrix(intCount, intCol)
                End If
            Next
        End With
        lblShare(1).Caption = "待分摊费用："
        lblShare(1).Caption = lblShare(1).Caption & dblTmp & " - 已分摊费用：0"
        lblShare(1).Caption = lblShare(1).Caption & " = " & dblTmp
    End If
End Sub

'栏目设置
Private Sub RailSet_Click()
    Dim blnTmp As Boolean
    Dim intCol As Integer
    
    If mintIsListActivate = 1 Then
        mclsProcurementCostGrid.ListSet.SaveList
        intCol = GetColNO(msgProcurementCost, "单据号")      '将排序列设在必选选列上
        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, mblnArrIsFilter(0)
            mclsProcurementCostGrid.ListSetToGrid
            mclsProcurementCostGrid.SetupStyle
            intCol = GetColNO(msgProcurementCost, "单据号")    '默认排序列
            mclsProcurementCostGrid.ColSort(intCol) = True
            mclsProcurementCostGrid.Sort intCol, 1
            msgProcurementCost.Refresh
        End If
    End If
    If mintIsListActivate = 2 Then
        mclsProcurementChangeGrid.ListSet.SaveList
        intCol = GetColNO(msgProcurementChange, "单据号")
        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, mblnArrIsFilter(1)
            mclsProcurementChangeGrid.ListSetToGrid
            mclsProcurementChangeGrid.SetupStyle
            intCol = GetColNO(msgProcurementChange, "单据号")
            mclsProcurementChangeGrid.ColSort(intCol) = True
            mclsProcurementChangeGrid.Sort intCol, 1
            msgProcurementChange.Refresh
        End If
    End If
    If mintIsListActivate = 3 Then
        mclsAddCostGrid.ListSet.SaveList
        intCol = GetColNO(msgAddCost, "单据号")
        mclsAddCostGrid.ColSort(intCol) = True         '将排序列设在必选选列上
        mclsAddCostGrid.Sort intCol, 1                 '升序排列
        blnTmp = mclsAddCostGrid.ListSet.ShowListSet(mintAddCostViewID)
        If blnTmp Then
            mclsAddCostGrid.ListSet.SaveList
            mclsAddCostGrid.ListSet.ViewId = mintAddCostViewID      '设置视图ID
            GetAddCostList mintAddCostViewID, mblnArrIsFilter(2)
            mclsAddCostGrid.ListSetToGrid
            mclsAddCostGrid.SetupStyle
            intCol = GetColNO(msgAddCost, "单据号")
            mclsAddCostGrid.ColSort(intCol) = True         '设置列表排序列
            mclsAddCostGrid.Sort intCol, 1                 '升序排列
            msgAddCost.Refresh
        End If
    End If
    If mintIsListActivate = 4 Then
        mclsAddChangeGrid.ListSet.SaveList
        intCol = GetColNO(msgAddChange, "单据号")
        mclsAddChangeGrid.ColSort(intCol) = True
        mclsAddChangeGrid.Sort intCol, 1
        blnTmp = mclsAddChangeGrid.ListSet.ShowListSet(mintAddChangeViewID)
        If blnTmp Then
            mclsAddChangeGrid.ListSet.SaveList
            mclsAddChangeGrid.ListSet.ViewId = mintAddChangeViewID
            GetAddChangeList mintAddChangeViewID, mblnArrIsFilter(3)
            mclsAddChangeGrid.ListSetToGrid