clsadjust.cls

金算盘软件代码

    '判断单据已否已作废
    blnVoid = recTemp!blnIsVoid
    '-------------------------------------------------------------------
    intYear = gclsBase.FYearOfDate(C2Date(recTemp!strDate))
    bytPeriod = gclsBase.PeriodOfDate(C2Date(recTemp!strDate))
    lngReceiptTypeID = recTemp!lngReceiptTypeID
    strReceiptNo = recTemp!strReceiptNo
    lngReceiptNo = recTemp!lngReceiptNo
    '--------------------------------------------------------------------
    recTemp.Close
    Set recTemp = Nothing
    
    '提问
    If blnByVoid Then
        If ShowMsg(thehWnd, "本张调拨单作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
    Else
        If blnVoid Then
            If ShowMsg(thehWnd, "您确定要删除本张已作废的商品调拨单吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
        Else
            If ShowMsg(thehWnd, "您确定要删除本张商品调拨单吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
        End If
    End If
    
    gclsBase.BaseWorkSpace.BeginTrans
   
        '找到本条代销调入对应的代销调出的ID
        strSql = "SELECT ItemActivity.lngActivityID FROM ItemActivity,ItemActivity ItemActivity_1 " _
               & " WHERE ItemActivity.lngActivityTypeID=28" & _
               " AND ItemActivity.lngReceiptNO = ItemActivity_1.lngReceiptNO" & _
               " AND ItemActivity.strReceiptNO = ItemActivity_1.strReceiptNO" & _
               " AND ItemActivity.lngReceiptTypeID = ItemActivity_1.lngReceiptTypeID" & _
               " AND ItemActivity.strDate = ItemActivity_1.strDate" & _
               " AND ItemActivity_1.lngActivityID=" & lngActivityID
        Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recTemp.BOF And recTemp.EOF Then Exit Function
        lngActivityID_OUT = recTemp(0)
        Set recTemp = Nothing
   
         '更改商品相关各表
'        strSql = "UPDATE (ItemActivityDetail INNER JOIN LendToSale ON ItemActivityDetail.lngActivityDetailID = LendToSale.lngLendActivityDetailID) INNER JOIN ItemActivityDetail AS ItemActivityDetail_1 ON LendToSale.lngSaleActivityDetailID = ItemActivityDetail_1.lngActivityDetailID " _
'               & " SET ItemActivityDetail.dblSettlementQuantity = [ItemActivityDetail]![dblSettlementQuantity]-[LendToSale]![dblQuantity], ItemActivityDetail.dblCurrSettlementAmount = [ItemActivityDetail]![dblCurrSettlementAmount]-[LendToSale]![dblCurrAmount] " _
'               & " WHERE (((ItemActivityDetail_1.lngActivityID)=" & lngActivityID_OUT & "))"
'        If gclsBase.ExecSQL(strSql) = False Then GoTo theErr
    '1）单据是作废单据，不执行
    If Not blnVoid Then
        If ChangeAllItem_from_Activity("D", lngActivityID) = False Then GoTo TheErr
        If ChangeAllItem_from_Activity("D", lngActivityID_OUT) = False Then GoTo TheErr
        If ModifyPositionWhenDeleteOutBill(lngActivityID) = False Then GoTo TheErr
        If ModifyPositionWhenDeleteOutBill(lngActivityID_OUT) = False Then GoTo TheErr
    End If
    
    '2）作废操作不执行
    If Not blnByVoid Then
        '包括“调入”和“调出”两部分
        strSql = "DELETE From ItemActivityDetail" _
               & " WHERE ItemActivityDetail.lngActivityID In (" & lngActivityID & "," & lngActivityID_OUT & ")"
        If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
        
        strSql = "DELETE From ItemActivity" _
               & " WHERE ItemActivity.lngActivityID In (" & lngActivityID & "," & lngActivityID_OUT & ")"
        If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
    Else
        strSql = "UPDATE ItemActivity SET ItemActivity.blnIsVoid = 1 WHERE ItemActivity.lngActivityID In(" & lngActivityID & "," & lngActivityID_OUT & ")"
        If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
    End If
     

'------------------------------------------------------------------------------
    If Not blnByVoid Then blnMaxNODecrease intYear, bytPeriod, lngReceiptTypeID, strReceiptNo, lngReceiptNo
'------------------------------------------------------------------------------
    
    gclsBase.BaseWorkSpace.CommitTrans
    DeleteAdjust = True
    Exit Function
TheErr:
    gclsBase.BaseWorkSpace.RollBacktrans
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    cMsgBox Left(strDelOrVoid, 2) & "商品调拨单失败！"
End Function

'*****************************************商品调价*****************************************

Public Function DeleteAdjustPrice(arglngActivityID As Long, Optional blnByVoid As Boolean, Optional blnShowMsg As Boolean = True) As Boolean
    Dim strSql As String
    Dim intResult As Integer
    Dim strDelOrVoid As String
    Dim blnVoid As Boolean
    Dim recTmp As rdoResultset
    
    On Error GoTo TheErr
    '-----------------------------------------
    Dim intYear As Integer '凭证会计年度
    Dim bytPeriod As Byte   '凭证会计期间
    Dim lngReceiptTypeID As Long
    Dim strReceiptNo As String
    Dim lngReceiptNo As Long
    '------------------------------------------
    If blnByVoid Then
        strDelOrVoid = "作废！"
    Else
        strDelOrVoid = "删除！"
    End If
    
    lngActivityID = arglngActivityID
    
    '规则判断
    Select Case IsVoucher_ItemActivity(lngActivityID)
    Case -1
        GoTo TheErr
    Case 1
        If blnShowMsg Then cMsgBox "本张商品调价单已经生成记帐凭证，不能" & strDelOrVoid
        DeleteAdjustPrice = 0
        Exit Function
    End Select
    
    strSql = "SELECT * From ItemActivity WHERE (lngActivityID)=" & lngActivityID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTmp.EOF Then
        DeleteAdjustPrice = True
        Set recTmp = Nothing
        Exit Function
    End If
    '判断单据已否已作废
    blnVoid = recTmp!blnIsVoid
    '-------------------------------------------------------------------
    intYear = gclsBase.FYearOfDate(C2Date(recTmp!strDate))
    bytPeriod = gclsBase.PeriodOfDate(C2Date(recTmp!strDate))
    lngReceiptTypeID = recTmp!lngReceiptTypeID
    strReceiptNo = recTmp!strReceiptNo
    lngReceiptNo = recTmp!lngReceiptNo
    '--------------------------------------------------------------------
    recTmp.Close
    Set recTmp = Nothing
    
    If blnVoid = False Then
        '判断本掉价单中商品本单据之后是否发生业务
        If HaveActivity(lngActivityID) = True Then
            If blnShowMsg Then cMsgBox "本张商品调价单中所涉及商品已根据本单据之新价格发生业务，不能" & strDelOrVoid, ""
            DeleteAdjustPrice = 0
            Exit Function
        End If
    End If
    '提问
    If blnByVoid Then
        If blnShowMsg Then
            If ShowMsg(thehWnd, "本张商品调价单作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
        End If
    Else
        If blnShowMsg Then
        If blnVoid Then
            If ShowMsg(thehWnd, "您确定要删除本张已作废的商品调价单吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
        Else
            If ShowMsg(thehWnd, "您确定要删除本张商品调价单吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
        End If
        End If
    End If
    
    gclsBase.BaseWorkSpace.BeginTrans
   
    '1）单据是作废单据，不执行
    If Not blnVoid Then
        If ChangeAllItem_from_Activity("D", lngActivityID) = False Then GoTo TheErr
        '删除或作废后还原商品零售价/计划价----------------------------------------------------------------------
        strSql = "SELECT Item.lngItemID,Item.strItemName,Item.strRecentDate,Item.dblPlanPrice,Item.dblRetainPrice,ItemNature.strCostMethod,ItemActivityDetail.dblCurrPrice,ItemActivityDetail.dblCurrNewPrice,ItemActivity.strDate " & _
                " FROM Item,ItemNature," & _
                "ItemActivityDetail," & _
                "ItemActivity " & _
                " WHERE ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID AND Item.lngItemID=ItemActivityDetail.lngItemID AND Item.lngItemNatureID=ItemNature.lngItemNatureID AND ItemActivity.lngActivityID=" & lngActivityID & " ORDER BY Item.lngItemID"
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenDynamic)
        Dim strDate As String
        Dim dblOldPrice As Double
        Dim lngItemID As Long
        lngItemID = 0
        Do While recTmp.EOF = False
            If lngItemID = recTmp!lngItemID Then
                GoTo NextOne
            Else
                lngItemID = recTmp!lngItemID
            End If
            strDate = recTmp!strDate
            If AfterHaveActivity(recTmp!lngItemID, strDate, lngActivityID) = True Then
                    strDate = recTmp!strItemName
                    gclsBase.BaseWorkSpace.RollBacktrans
                    Set recTmp = Nothing
                    If blnShowMsg Then cMsgBox "本张调价单中的商品“" & strDate & "”在本次调价之后已经发生业务，因此本张商品调价单不允许" & Left(strDelOrVoid, 2) & "！"
                    DeleteAdjustPrice = False
                    Exit Function
            End If
            dblOldPrice = FindLastAdjustPrice(recTmp!lngItemID, lngActivityID, strDate)
            If dblOldPrice <> -1 Then
                If strDate >= recTmp!strDate Then
                    '最后一张日期大于当前单据日期
                    strDate = recTmp!strItemName
                    gclsBase.BaseWorkSpace.RollBacktrans
                    Set recTmp = Nothing
                    If blnShowMsg Then cMsgBox "本张调价单中的商品“" & strDate & "”在本次调价之后又调过价，因此本张商品调价单不允许" & Left(strDelOrVoid, 2) & "！"
                    DeleteAdjustPrice = False
                    Exit Function
                End If
                If dblOldPrice <> recTmp!dblCurrPrice Then
                    '上一张的新价不等于本张原价
                End If
            End If
            If dblOldPrice < 0 Then
                dblOldPrice = recTmp!dblCurrPrice
            End If
            If strDate = "" Then strDate = " "
            If recTmp!strCostMethod = "6" Then
                strSql = "UPDATE Item SET dblPlanPrice = " & dblOldPrice & ",strRecentDate ='" & strDate & "' WHERE lngItemID=" & recTmp!lngItemID
                If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
            Else
                strSql = "UPDATE Item set dblRetainPrice = " & dblOldPrice & ",strRecentDate ='" & strDate & "' WHERE lngItemID=" & recTmp!lngItemID
                If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
            End If
NextOne:
            recTmp.MoveNext
        Loop
        recTmp.Close
        Set recTmp = Nothing
        '----------------------------------------------------------------------------------------------------
    End If
    
    '2）作废操作不执行
    If Not blnByVoid Then
        If DeleteItemActivityANDItemActivityDetail(lngActivityID) <> 0 Then GoTo TheErr
            
    Else
        strSql = "UPDATE ItemActivity SET ItemActivity.blnIsVoid = 1 WHERE ItemActivity.lngActivityID=" & lngActivityID
        If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
    End If

'------------------------------------------------------------------------------
    If Not blnByVoid Then blnMaxNODecrease intYear, bytPeriod, lngReceiptTypeID, strReceiptNo, lngReceiptNo
'------------------------------------------------------------------------------
    
    gclsBase.BaseWorkSpace.CommitTrans
    DeleteAdjustPrice = True
    Exit Function
TheErr:
    gclsBase.BaseWorkSpace.RollBacktrans
    If Not recTmp Is Nothing Then
        Set recTmp = Nothing
    End If
    If blnShowMsg Then cMsgBox Left(strDelOrVoid, 2) & "商品调价单失败！"
End Function