frmentrustamount.frm

金算盘软件代码

        If mblnIsAddChangeEmpoty Then
            With msgAddChange
                intCol = GetColNO(msgAddChange, "日期", mintAddChangeViewID)
                lngCustomerID = 0
                For intCount = 1 To .Rows - 1
                    If .TextMatrix(intCount, 1) = "√" Then
                        lngCustomerID = .TextMatrix(intCount, 2)
                        If Trim(.TextMatrix(intCount, intCol1)) <> "" Then
                            dblTmp = CDbl(.TextMatrix(intCount, intCol1))
                        End If
                        Exit For
                    End If
                Next
'                If lngCustomerID = 0 Then
'                    For intCount = 0 To msgAddCost.Rows - 1
'                        If msgAddCost.TextMatrix(intCount, 1) = "√" Then
'                            lngCustomerID = msgAddCost.TextMatrix(intCount, 2)
'                            Exit For
'                        End If
'                    Next
'                End If
                 For intCount = 1 To .Rows - 1
                    .TextMatrix(intCount, 1) = ""
                Next
'                If lngCustomerID = 0 And .Row > 0 And .Row < .Rows Then
'                    lngCustomerID = .TextMatrix(.Row, 2)
'                End If
                lngTmpRow = 0
                For intCount = 1 To .Rows - 1
                    strDate2 = Format(.TextMatrix(intCount, intCol), "yyyy-mm-dd")
                    If .RowHeight(intCount) > 0 And strDate2 <= strDate1 Then    '保证隐藏行不再选择
'                        If lngCustomerID > 0 Then
'                            If .TextMatrix(intCount, 2) = lngCustomerID Then
                                .TextMatrix(intCount, 1) = "√"
                                lngTmpRow = intCount
'                            End If
'                        Else
'                            .TextMatrix(intCount, 1) = "√"
'                            lngCustomerID = .TextMatrix(intCount, 2)
'                            lngTmpRow = intCount
'                        End If
                    End If
                Next
                If lngTmpRow > 0 Then
                    .Row = lngTmpRow
                Else
                    .Row = .Rows - 1
                End If
            End With
            On Error Resume Next
            msgAddChange.SetFocus
            On Error GoTo 0
            txtShare2Set
        End If
    End If
End Sub


Private Sub Cancel_Click()
    Unload Me
End Sub

Private Sub cmdArr_Click(Index As Integer)
    Select Case Index
    Case 0
        Ok_click                '确定
    Case 1
        Cancel_Click            '取消
    Case 2
        Related_Click           '关联
    Case 3
        CostToShare_Click       '计算分摊费用
    Case 4
        If txtAddCost.Visible = True Then txtAddCost.Visible = False
        If txtAddChange.Visible = True Then txtAddChange.Visible = False
        NoCostToShare_Click     '取消费用分摊
    Case 5
        RailSet_Click           '栏目设置
    Case 6
        Filt_Click              '筛选
    Case 7
        Allselect_Click         '全部选择
    Case 8
        ConditionSelect_Click   '条件选择
    Case 9
        AllCancel_Click         '全部取消
    Case 10
        Del_OldCost             '清除分摊
        On Error Resume Next
        msgAddCost.SetFocus
        On Error GoTo 0
    End Select
End Sub

'条件选择
Private Sub ConditionSelect_Click()
    Dim intCol As Integer
    Dim blnTmp As Boolean
    
    If mintIsListActivate <> 1 And mintIsListActivate <> 2 Then
        mintIsListActivate = 1
    End If
    If mintIsListActivate = 1 Then
        If mblnIsAddCostEmpoty Then
            mclsAddCostGrid.ListSet.SaveList
            Filter.ShowFilter mclsAddCostGrid.ListSet.ListID, 1, , , , , blnTmp, , "条件选择"
            If blnTmp Then
                mclsAddCostGrid.ListSet.SaveList
                mclsAddCostGrid.ListSet.ViewId = mintAddCostViewID
                RefashConditionSelect                               '刷新条件选择并为符合条件选择的记录打上标志
            End If
            On Error Resume Next
            msgAddCost.SetFocus
            On Error GoTo 0
        End If
    End If
    If mintIsListActivate = 2 Then
        If mblnIsAddChangeEmpoty Then
            mclsAddChangeGrid.ListSet.SaveList
            Filter.ShowFilter mclsAddChangeGrid.ListSet.ListID, 1, , , , , blnTmp, , "条件选择"
            If blnTmp Then
                mclsAddChangeGrid.ListSet.SaveList
                mclsAddChangeGrid.ListSet.ViewId = mintAddChangeViewID
                RefashConditionSelect                             '刷新条件选择并为符合条件选择的记录打上标志
            End If
            On Error Resume Next
            msgAddChange.SetFocus
            On Error GoTo 0
        End If
    End If
End Sub

'刷新条件选择并为符合条件选择的记录打上标志
Private Sub RefashConditionSelect()
    Dim recRecordset As rdoResultset
    Dim strSelectOfSql As String
    Dim strFromOfSql As String
    Dim strWhereOfSql As String
    Dim strSql As String
    Dim intCount1 As Integer
    Dim intCount2 As Integer
    Dim lngTmpID As Long
    Dim intCol1 As Integer
    Dim intCol2 As Integer
    Dim blnTmp As Boolean
    Dim blnIsFirst As Boolean
    Dim dblCost As Double
    Dim dblTmp As Double
    Dim lngCustomerID As Long
    
    If mintIsListActivate = 1 Then
        With mclsAddCostGrid.ListSet
            strSelectOfSql = "select ItemActivityDetail.lngActivityDetailID 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.OpenResultset(strSql, rdOpenStatic)
        If Not recRecordset.EOF Then
            recRecordset.MoveLast
            recRecordset.MoveFirst
            intCol1 = GetColNO(msgAddCost, "本次分摊费用", mintAddCostViewID)
            intCol2 = GetColNO(msgAddCost, "未分摊费用", mintAddCostViewID)
            dblCost = 0
            dblTmp = 0
            lngCustomerID = 0
            With msgAddCost
                For intCount1 = 1 To .Rows - 1
                    If .TextMatrix(intCount1, 1) = "√" Then
                        If Trim(.TextMatrix(intCount1, intCol1)) <> "" Then
                            dblTmp = CDbl(.TextMatrix(intCount1, intCol1))
                        End If
                        Exit For
                    End If
                Next
'                If lngCustomerID = 0 Then
'                    For intCount1 = 0 To msgAddChange.Rows - 1
'                        If msgAddChange.TextMatrix(intCount1, 1) = "√" Then
'                            lngCustomerID = msgAddChange.TextMatrix(intCount1, 2)
'                            Exit For
'                        End If
'                    Next
'                End If
                For intCount1 = 1 To .Rows - 1
                    .TextMatrix(intCount1, 1) = ""       '清除选择费用项目标志
                    .TextMatrix(intCount1, intCol1) = ""
                Next
                blnTmp = False
                blnIsFirst = True
                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
                                If Trim(.TextMatrix(intCount2, intCol2)) <> "" Then
                                    If blnIsFirst Then
'                                        If lngCustomerID > 0 Then
'                                            If .TextMatrix(intCount2, 2) = lngCustomerID Then
                                                dblTmp = CDbl(.TextMatrix(intCount2, intCol2))
                                                blnIsFirst = False
                                                .TextMatrix(intCount2, 1) = "√"                                  '打上选取标志
                                                .TextMatrix(intCount2, intCol1) = .TextMatrix(intCount2, intCol2)  '重写修改列的值
                                                blnTmp = True
'                                            End If
'                                        Else
'                                            dblTmp = CDbl(.TextMatrix(intCount2, intCol2))
'                                            blnIsFirst = False
'                                            .TextMatrix(intCount2, 1) = "√"                                  '打上选取标志
'                                            .TextMatrix(intCount2, intCol1) = .TextMatrix(intCount2, intCol2)  '重写修改列的值
'                                            blnTmp = True
'                                            lngCustomerID = .TextMatrix(intCount2, 2)
'                                        End If
                                    Else
                                        dblCost = CDbl(.TextMatrix(intCount2, intCol2))
                                        If Sgn(dblTmp) = Sgn(dblCost) Then   'And .TextMatrix(intCount2, 2) = lngCustomerID   '只选全部为正或全部为负的单据
                                            .TextMatrix(intCount2, 1) = "√"                                  '打上选取标志
                                            .TextMatrix(intCount2, intCol1) = .TextMatrix(intCount2, intCol2)  '重写修改列的值
                                            blnTmp = True
                                        End If
                                    End If
                                End If
                            End If
                        End If
                    Next
                    recRecordset.MoveNext
                Next
                txtShare2Set        '待分摊费用，已分摊费用设置
            End With
        Else
            ShowMsg msgAddCost.hWnd, "没有符合条件选择的加工费用记录。", vbInformation, Me.Caption   '显示对话框
        End If
        recRecordset.Close
        Set recRecordset = Nothing
    End If
    
    If mintIsListActivate = 2 Then
        With mclsAddChangeGrid.ListSet
            strSelectOfSql = "select ItemActivityDetail.lngActivityDetailID 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.OpenResultset(strSql, rdOpenStatic)
        If Not recRecordset.EOF Then
            recRecordset.MoveLast
            recRecordset.MoveFirst
            intCol1 = GetColNO(msgAddChange, "本次分摊费用", mintAddChangeViewID)
            lngCustomerID = 0
            With msgAddChange
                For intCount1 = 1 To .Rows - 1
                    If .TextMatrix(intCount1, 1) = "√" Then
                        If Trim(.TextMatrix(intCount1, intCol1)) <> "" Then
                            dblTmp = CDbl(.TextMatrix(intCount1, intCol1))
                        End If
                        Exit For
                    End If
                Next
'                If lngCustomerID = 0 Then
'                    For intCount1 = 0 To msgAddCost.Rows - 1
'                        If msgAddCost.TextMatrix(intCount1, 1) = "√" Then
'                            lngCustomerID = msgAddCost.TextMatrix(intCount1, 2)
'                            Exit For
'                        End If
'                    Next
'                End If
                For intCount1 = 1 To .Rows - 1
                    .TextMatrix(intCount1, 1) = ""       '清除选择商品项目标志
                    .TextMatrix(intCount1, intCol1) = ""
                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
'                                If lngCustomerID > 0 Then
'                                    If .TextMatrix(intCount2, 2) = lngCustomerID Then
                                        .TextMatrix(intCount2, 1) = "√"     '选择商品项目打上标志
                                        blnTmp = True
'                                    End If
'                                Else
'                                    .TextMatrix(intCount2, 1) = "√"     '选择商品项目打上标志
'                                    blnTmp = True
'                                    lngCustomerID = .TextMatrix(intCount2, 2)
'                                End If
                            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
    Dim blnSave As Boolean
    Dim i As Integer