frmentrustamount.frm

金算盘软件代码

    Dim lngYESNO As Long
    
    If mintIsListActivate <> 1 And mintIsListActivate <> 2 Then
        mintIsListActivate = 1
    End If
    If mintIsListActivate = 1 Then
        blnSave = False
        With msgAddCost
            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 + vbYesNo + vbDefaultButton2, Me.Caption)
            If lngYESNO = vbNo Then
                Exit Sub
            End If
            With msgAddCost
                For i = 1 To .Rows - 1
                    .TextMatrix(i, 1) = ""
                Next
            End With
        End If
        mclsAddCostGrid.ListSet.SaveList
        Filter.ShowFilter mclsAddCostGrid.ListSet.ListID, 1, , , , , blnTmp    '调用筛选
        If blnTmp Then            '按确定返回
            mclsAddCostGrid.ListSet.SaveList
            mclsAddCostGrid.ListSet.ViewId = mintAddCostViewID
            GetAddCostList mintAddCostViewID              '设置列表记录集
            mblnArrIsFilter(0) = False
            mclsAddCostGrid.ListSetToGrid
            mclsAddCostGrid.SetupStyle
            intCol = GetColNO(msgAddCost, "加工费用单号", mintAddCostViewID)
            mclsAddCostGrid.ColSort(intCol) = True         '设置列表排序列
            mclsAddCostGrid.Sort intCol, 1                 '升序排列
            CalDate_LostFocus
            mclsAddCostGrid.Grid.Refresh
        End If
        On Error Resume Next
        msgAddCost.SetFocus
        On Error GoTo 0
    End If
    If mintIsListActivate = 2 Then
        blnSave = False
        With msgAddChange
            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 + vbYesNo + vbDefaultButton2, Me.Caption)
            If lngYESNO = vbNo Then
                Exit Sub
            End If
            With msgAddChange
                For i = 1 To .Rows - 1
                    .TextMatrix(i, 1) = ""
                Next
            End With
        End If
        mclsAddChangeGrid.ListSet.SaveList
        Filter.ShowFilter mclsAddChangeGrid.ListSet.ListID, 1, , , , , blnTmp
        If blnTmp Then        '按确定返回
            mclsAddChangeGrid.ListSet.SaveList
            mclsAddChangeGrid.ListSet.ViewId = mintAddChangeViewID
            GetAddChangeList mintAddChangeViewID
            mblnArrIsFilter(1) = False
            mclsAddChangeGrid.ListSetToGrid
            mclsAddChangeGrid.SetupStyle
            intCol = GetColNO(msgAddChange, "加工入库单号", mintAddChangeViewID)
            mclsAddChangeGrid.ColSort(intCol) = True
            mclsAddChangeGrid.Sort intCol, 1
            CalDate_LostFocus
            mclsAddChangeGrid.Grid.Refresh
        End If
        On Error Resume Next
        msgAddChange.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(msgAddChange, "本次分摊费用", mintAddChangeViewID)
    With msgAddChange
        For intCount = 1 To .Rows - 1
            .TextMatrix(intCount, 1) = ""
            .TextMatrix(intCount, intCol) = ""
        Next
    End With
    intCol = GetColNO(msgAddCost, "本次分摊费用", mintAddCostViewID)
    With msgAddCost
        For intCount = 1 To .Rows - 1
            .TextMatrix(intCount, 1) = ""
            .TextMatrix(intCount, intCol) = ""
        Next
    End With
    txtShare2Set
    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 msgAddCost
            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 + vbYesNo + vbDefaultButton2, Me.Caption)
            If lngYESNO = vbYes Then
                intCol = GetColNO(msgAddCost, "本次分摊费用", mintAddCostViewID)
                With msgAddCost
                    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 .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 msgAddCost
                    For i = 1 To .Rows - 1
                       .TextMatrix(i, 1) = ""
                    Next
                End With
            End If
        End If
        mclsAddCostGrid.ListSet.SaveList
        intCol = GetColNO(msgAddCost, "加工费用单号", mintAddCostViewID)
        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
            mclsAddCostGrid.ListSetToGrid
            mclsAddCostGrid.SetupStyle
            intCol = GetColNO(msgAddCost, "加工费用单号", mintAddCostViewID)
            mclsAddCostGrid.ColSort(intCol) = True         '设置列表排序列
            mclsAddCostGrid.Sort intCol, 1                 '升序排列
            CalDate_LostFocus
            msgAddCost.Refresh
            If lngYESNO = vbYes Then
                intCol = GetColNO(msgAddCost, "本次分摊费用", mintAddCostViewID)
                With msgAddCost
                    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
                txtShare2Set
            End If
        End If
        On Error Resume Next
        msgAddCost.SetFocus
        On Error GoTo 0
    End If
    If mintIsListActivate = 2 Then
        blnSave = False
        With msgAddChange
            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 + vbYesNo + vbDefaultButton2, Me.Caption)
            If lngYESNO = vbYes Then
                intCol = GetColNO(msgAddChange, "本次分摊费用", mintAddChangeViewID)
                With msgAddChange
                    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 .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 msgAddChange
                    For i = 1 To .Rows - 1
                       .TextMatrix(i, 1) = ""
                    Next
                End With
            End If
        End If
        mclsAddChangeGrid.ListSet.SaveList
        intCol = GetColNO(msgAddChange, "加工入库单号", mintAddChangeViewID)
        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
            mclsAddChangeGrid.ListSetToGrid
            mclsAddChangeGrid.SetupStyle
            intCol = GetColNO(msgAddChange, "加工入库单号", mintAddChangeViewID)
            mclsAddChangeGrid.ColSort(intCol) = True
            mclsAddChangeGrid.Sort intCol, 1
            CalDate_LostFocus
            msgAddChange.Refresh
            If lngYESNO = vbYes Then
                intCol = GetColNO(msgAddChange, "本次分摊费用", mintAddChangeViewID)
                With msgAddChange
                    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
                txtShare2Set
            End If
        End If
        On Error Resume Next
        msgAddChange.SetFocus
        On Error GoTo 0
    End If
    UpdateMenuStatus    '设置菜单可用属性
End Sub

'计算分摊费用
Private Sub CostToShare_Click()
    Dim dblCostToshare As Double
    Dim dblOldCostToShare As Double
    Dim intCount As Integer
    Dim intAmountCol As Integer
    Dim intCostCol As Integer
    Dim intCostToShareCol As Integer
    Dim dblAmount As Double
    Dim dblCost As Double
    Dim dblCostTemp As Double
    Dim dblAmountTemp As Double
    Dim intCol1 As Integer
    Dim dblCostToShareSum As Double
    Dim dblLastShare As Double
    Dim dblTemp As Double
    Dim intCol As Integer
    Dim dblTmp1 As Double
    Dim dblTmp2 As Double
    Dim dblTmpShare As Double
    
    With msgAddCost
        If txtAddCost.Visible = True Then
            .col = 2
        End If
        If txtAddChange.Visible = True Then
            msgAddChange.col = 2
        End If