clssales.cls

金算盘软件代码

                    Exit Function
                End If
                Set clsTmp = Nothing
                blnIsWriteOff = True
            End If
        Next
'        gclsBase.BaseWorkSpace.CommitTrans
    End If
'    gclsBase.BaseWorkSpace.BeginTrans
    
    If Not blnIsVoid Then
            intResult = DeleteRelation(lngActivityID, lngActivityTypeID, thehWnd)
            If intResult <> 1 Then GoTo DeleteErr
    End If
    
    '1）单据是作废单据，不执行
    If Not blnIsVoid Then
        If ChangeAllItem_from_Activity("D", lngActivityID) = False Then GoTo DeleteErr
        If ChangeAllAccount_from_Activity("D", lngActivityID) = False Then GoTo DeleteErr
        If ModifyItemTable(lngActivityID, False) = False Then GoTo DeleteErr  '维护商品表（再定量、再销量、价格）
        If DeleteObtendTables() <> 1 Then GoTo DeleteErr
        #If conQuanDisc = -1 Then
            If ModifyOutStockQuantity(0, lngActivityID, False) = False Then GoTo DeleteErr
        #End If
    End If
    
    '2）作废操作不执行
    If Not blnByVoid Then
        If DeleteItemActivityANDItemActivityDetail(lngActivityID) <> 0 Then GoTo DeleteErr
    Else
        If gclsBase.ExecSQL("UPDATE ItemActivity SET blnIsVoid = 1," & _
            " blnIsCash = 0 WHERE lngActivityID=" & lngActivityID) = False Then GoTo DeleteErr
    End If
'------------------------------------------------------------------------------
    If Not blnByVoid Then blnMaxNODecrease intYear, bytPeriod, lngReceiptTypeID, strReceiptNo, lngReceiptNo
'------------------------------------------------------------------------------
    If Not blnNoTrans Then
        gclsBase.BaseWorkSpace.CommitTrans
    End If
    gclsSys.SendMessage 0, 32 + lngActivityTypeID
    DeleteSales = True
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    Exit Function
DeleteErr:
   On Error Resume Next
    If Not blnNoTrans Then
        gclsBase.BaseWorkSpace.RollBacktrans
    End If
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    blnIsWriteOff = False
    Screen.MousePointer = vbDefault
    If mstrErrMsg = "" Then
        cMsgBox Left(strDelOrVoid, 2) & strTypeName & "单据失败！"
    Else
        cMsgBox mstrErrMsg
    End If
End Function

Private Sub Class_Terminate()
    Erase lngWriteOffID
End Sub
Private Function SetStockTakingPost() As Boolean
    Dim strSQL As String
    Dim recTmp As rdoResultset
    Dim lngStockTakingID As Long
    
    On Error GoTo ErrHandle
    
    If lngActivityTypeID <> 9 And lngActivityTypeID <> 21 Then
        GoTo EndProc
        
    End If
    strSQL = "SELECT lngOrderDetailID FROM ItemActivityDetail,ItemActivity WHERE " _
        & "ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID " _
        & "AND ItemActivity.blnIsVoid=0 AND ItemActivity.lngActivityTypeID IN (9,21) AND lngOrderDetailID <> 0 And " _
        & "ItemActivity.lngActivityID=" & lngActivityID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
    If recTmp.BOF And recTmp.EOF Then
        GoTo EndProc
    End If
    lngStockTakingID = recTmp(0)
    recTmp.Close
    Set recTmp = Nothing
    strSQL = "SELECT lngOrderDetailID FROM ItemActivityDetail , ItemActivity WHERE " _
        & "ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID " _
        & "AND ItemActivity.blnIsVoid=0 AND ItemActivity.lngActivityTypeID IN (9,21) AND lngOrderDetailID=" & lngStockTakingID & "  And " _
        & "ItemActivity.lngActivityID<>" & lngActivityID
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenForwardOnly)
    If recTmp.BOF And recTmp.EOF Then
        strSQL = "UPDATE StockTaking set blnIsPost=0 WHERE lngStockTakingID=" & lngStockTakingID
        If gclsBase.ExecSQL(strSQL) = False Then
            GoTo ErrHandle
        End If
    Else
        GoTo EndProc
    End If
    
EndProc:
    SetStockTakingPost = True
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    Exit Function
ErrHandle:
    SetStockTakingPost = False
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    Exit Function
End Function

Private Function ClearInvoiceObtend() As Boolean
    Dim strSQL As String
    
    Select Case lngActivityTypeID
    Case 11, 12, 14, 17
        strSQL = "UPDATE ItemActivityDetail SET ItemActivityDetail.dblInvoiceQuantity=" & _
            " (SELECT ItemActivityDetail.dblInvoiceQuantity-NVL(Sum(SaleToInvoice.dblQuantity),0) " & _
            " FROM SaleToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " Where SaleToInvoice.lngInvoiceDetailID = ItemActivityDetail.lngActivityDetailID " & _
            " AND SaleToInvoice.lngReceiptDetailID = ItemActivityDetail_1.lngActivityDetailID " & _
            " AND ItemActivityDetail_1.lngActivityID = " & lngActivityID & "), " & _
            " ItemActivityDetail.dblCurrInvoiceAmount=" & _
            "(SELECT ItemActivityDetail.dblCurrInvoiceAmount-NVL(Sum(SaleToInvoice.dblCurrAmount),0) FROM SaleToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " Where SaleToInvoice.lngInvoiceDetailID = ItemActivityDetail.lngActivityDetailID " & _
            " AND SaleToInvoice.lngReceiptDetailID = ItemActivityDetail_1.lngActivityDetailID " & _
            " AND ItemActivityDetail_1.lngActivityID = " & lngActivityID & ") " & _
            " WHERE EXISTS (SELECT ItemActivityDetail_1.lngActivityID FROM SaleToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " WHERE SaleToInvoice.lngInvoiceDetailID = ItemActivityDetail.lngActivityDetailID " & _
            " AND SaleToInvoice.lngReceiptDetailID = ItemActivityDetail_1.lngActivityDetailID " & _
            " AND ItemActivityDetail_1.lngActivityID = " & lngActivityID & ") "
        If gclsBase.ExecSQL(strSQL) = False Then
            GoTo EndProc
        End If
        strSQL = "UPDATE ItemActivityDetail SET " & _
            " ItemActivityDetail.dblCostAmount=(SELECT ItemActivityDetail.dblCostAmount- " & _
            " Sum(ItemActivityDetail_1.dblCostAmount*SaleToInvoice.dblCurrAmount/(ItemActivityDetail_1.dblCurrAmount+ItemActivityDetail_1.dblCurrTaxAmount)) " & _
            " FROM SaleToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " WHERE SaleToInvoice.lngInvoiceDetailID=ItemActivityDetail.lngActivityDetailID " & _
            " AND SaleToInvoice.lngReceiptDetailID = ItemActivityDetail_1.lngActivityDetailID " & _
            " AND ItemActivityDetail_1.lngActivityID = " & lngActivityID & ") " & _
            " ,ItemActivityDetail.dblCostDiff=(SELECT ItemActivityDetail.dblCostDiff-" & _
            " Sum(ItemActivityDetail_1.dblCostDiff*SaleToInvoice.dblCurrAmount/(ItemActivityDetail_1.dblCurrAmount+ItemActivityDetail_1.dblCurrTaxAmount)) " & _
            " FROM SaleToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " WHERE SaleToInvoice.lngInvoiceDetailID=ItemActivityDetail.lngActivityDetailID " & _
            " AND SaleToInvoice.lngReceiptDetailID = ItemActivityDetail_1.lngActivityDetailID " & _
            " AND ItemActivityDetail_1.lngActivityID = " & lngActivityID & ") " & _
            " ,ItemActivityDetail.dblSaleTax=(SELECT ItemActivityDetail.dblSaleTax-" & _
            " Sum(ItemActivityDetail_1.dblSaleTax*SaleToInvoice.dblCurrAmount/(ItemActivityDetail_1.dblCurrAmount+ItemActivityDetail_1.dblCurrTaxAmount)) " & _
            " FROM SaleToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " WHERE SaleToInvoice.lngInvoiceDetailID=ItemActivityDetail.lngActivityDetailID " & _
            " AND SaleToInvoice.lngReceiptDetailID = ItemActivityDetail_1.lngActivityDetailID " & _
            " AND ItemActivityDetail_1.lngActivityID = " & lngActivityID & ") " & _
            " WHERE EXISTS (SELECT ItemActivityDetail_1.lngActivityDetailID " & _
            " FROM SaleToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " WHERE SaleToInvoice.lngInvoiceDetailID=ItemActivityDetail.lngActivityDetailID " & _
            " AND SaleToInvoice.lngReceiptDetailID = ItemActivityDetail_1.lngActivityDetailID " & _
            " AND ItemActivityDetail_1.lngActivityID = " & lngActivityID & ") "
        If gclsBase.ExecSQL(strSQL) = False Then
            GoTo EndProc
        End If
        strSQL = "UPDATE ItemActivity SET ItemActivity.blnInvoiceClose=0 " & _
            " WHERE EXISTS (SELECT ItemActivityDetail_1.lngActivityID FROM ItemActivityDetail,SaleToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " WHERE ItemActivityDetail.lngActivityDetailID=SaleToInvoice.lngInvoiceDetailID " & _
            " AND SaleToInvoice.lngReceiptDetailID = ItemActivityDetail_1.lngActivityDetailID " & _
            " AND ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID " & _
            " AND ItemActivityDetail_1.lngActivityID = " & lngActivityID & ")"
        If gclsBase.ExecSQL(strSQL) = False Then
            GoTo EndProc
        End If
        strSQL = "DELETE FROM SaleToInvoice WHERE EXISTS (SELECT ItemActivityDetail.lngActivityID " & _
            " FROM ItemActivityDetail WHERE SaleToInvoice.lngReceiptDetailID = ItemActivityDetail.lngActivityDetailID " & _
            " AND ItemActivityDetail.lngActivityID = " & lngActivityID & ")"
        If gclsBase.ExecSQL(strSQL) = False Then
            GoTo EndProc
        End If
    Case 18
        strSQL = "UPDATE ItemActivityDetail SET ItemActivityDetail.dblInvoiceQuantity=" & _
            " (SELECT ItemActivityDetail.dblInvoiceQuantity-NVL(Sum(SaleToInvoice.dblQuantity),0) " & _
            " FROM SaleToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " Where SaleToInvoice.lngReceiptDetailID = ItemActivityDetail.lngActivityDetailID " & _
            " AND SaleToInvoice.lngInvoiceDetailID = ItemActivityDetail_1.lngActivityDetailID " & _
            " AND ItemActivityDetail_1.lngActivityID = " & lngActivityID & "), " & _
            " ItemActivityDetail.dblCurrInvoiceAmount=" & _
            "(SELECT ItemActivityDetail.dblCurrInvoiceAmount-NVL(Sum(SaleToInvoice.dblCurrAmount),0) FROM SaleToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " Where SaleToInvoice.lngReceiptDetailID = ItemActivityDetail.lngActivityDetailID " & _
            " AND SaleToInvoice.lngInvoiceDetailID = ItemActivityDetail_1.lngActivityDetailID " & _
            " AND ItemActivityDetail_1.lngActivityID = " & lngActivityID & ") , " & _
            " ItemActivityDetail.blnCloseInvoice=0 " & _
            " WHERE EXISTS (SELECT ItemActivityDetail_1.lngActivityID FROM SaleToInvoice,ItemActivityDetail ItemActivityDetail_1 " & _
            " WHERE SaleToInvoice.lngReceiptDetailID = ItemActivityDetail.lngActivityDetailID " & _
            " AND SaleToInvoice.lngInvoiceDetailID = ItemActivityDetail_1.lngActivityDetailID " & _
            " AND ItemActivityDetail_1.lngActivityID = " & lngActivityID & ") "
        If gclsBase.ExecSQL(strSQL) = False Then
            GoTo EndProc
        End If
        strSQL = "DELETE FROM SaleToInvoice WHERE EXISTS (SELECT ItemActivityDetail.lngActivityID " & _
            " FROM ItemActivityDetail WHERE SaleToInvoice.lngInvoiceDetailID = ItemActivityDetail.lngActivityDetailID " & _
            " AND ItemActivityDetail.lngActivityID = " & lngActivityID & ")"
        If gclsBase.ExecSQL(strSQL) = False Then
            GoTo EndProc
        End If
    End Select
    ClearInvoiceObtend = True
EndProc:
End Function


'判断有批次管理标志的入库类型业务是否已发生了出库类型等对应业务
Private Function IsProduce() As Integer
    Dim strSQL As String
    Dim recTemp As rdoResultset
On Error GoTo TheErr
    
    '判断批次商品有无出库等业务
    strSQL = "SELECT PositionItemDetail.lngInActivityDetailID" _
           & " FROM PositionItemDetail,ItemActivityDetail,ItemActivityDetail ItemActivityDetail_1 " _
           & " WHERE PositionItemDetail.lngInActivityDetailID = ItemActivityDetail.lngActivityDetailID " _
           & " AND PositionItemDetail.lngOutActivityDetailID = ItemActivityDetail_1.lngActivityDetailID " _
           & " AND (((ItemActivityDetail.lngActivityID)=" & lngActivityID & ") AND ItemActivityDetail_1.lngActivityID<>" & lngActivityID & " AND ((PositionItemDetail.lngOutActivityDetailID)<>0))"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSQL, rdOpenStatic)
    If Not recTemp.EOF Then
        IsProduce = 1 '批次商品已发生出库业务
    Else
        IsProduce = 0 '没有发生出库业务
    End If
    Set recTemp = Nothing
    Exit Function
TheErr:
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    IsProduce = -1
End Function