clsstocktaking.cls

金算盘软件代码

    
'------------------------------------------------------------------------------
    If Not blnByVoid Then blnMaxNODecrease intYear, bytPeriod, lngReceiptTypeID, strReceiptNo, lngReceiptNo
'------------------------------------------------------------------------------
    gclsBase.BaseWorkSpace.CommitTrans
    DeletePurchase = True
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    Exit Function
DeleteErr:
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    gclsBase.BaseWorkSpace.RollBacktrans
    Screen.MousePointer = vbDefault
End Function
'<接口>
'blnByVoid：删除功能由作废调用
Private Function DeleteSales(arglngActivityID As Long, Optional blnByVoid As Boolean) As Boolean
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim intResult As Integer
    '-----------------------------------------
    Dim intYear As Integer '凭证会计年度
    Dim bytPeriod As Byte   '凭证会计期间
    Dim lngReceiptTypeID As Long
    Dim strReceiptNo As String
    Dim lngReceiptNo As Long
    On Error GoTo DeleteErr
    '------------------------------------------
    lngActivityID = arglngActivityID
    
    strSql = "SELECT ItemActivity.lngActivityTypeID, ItemActivity.blnIsVoid, Decode(ItemActivity.lngActivityTypeID,11,'商品销售',12,'直运销售',13,'委托出库',14,'委托结算',15,'加工出库',16,'分期出库',17,'分期结算',18,'销售发票',19,'领用出库',20,'成本调整',21,'盘亏出库',22,'其他出库')AS 销售类型 ,ItemActivity.* From ItemActivity WHERE (ItemActivity.lngActivityID)=" & lngActivityID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then
 '       cMsgBox "列表的数据已被修改，请重新刷新后再进行操作！"
        DeleteSales = True
        Set recTemp = Nothing
        Exit Function
    End If
    lngActivityTypeID = recTemp(0)
    blnIsVoid = (recTemp(1) <> 0)
    strTypeName = recTemp(2)
    '-------------------------------------------------------------------
    intYear = gclsBase.FYearOfDate(C2Date(recTemp!strDate))
    bytPeriod = gclsBase.PeriodOfDate(C2Date(recTemp!strDate))
    lngReceiptTypeID = recTemp!lngReceiptTypeID
    strReceiptNo = recTemp!strReceiptNo
    lngReceiptNo = recTemp!lngReceiptNo
    '--------------------------------------------------------------------
    
    Set recTemp = Nothing
    
    
    gclsBase.BaseWorkSpace.BeginTrans
    
    
    '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 DeleteObtendTables_OUT() <> 1 Then GoTo DeleteErr
    End If
    
    '2）作废操作不执行
    If Not blnByVoid Then
        If DeleteItemActivityANDItemActivityDetail(lngActivityID) <> 0 Then GoTo DeleteErr
    Else
        If gclsBase.ExecSQL("UPDATE ItemActivity SET ItemActivity.blnIsVoid = 1 WHERE (((ItemActivity.lngActivityID)=" & lngActivityID & "));") = False Then GoTo DeleteErr
    End If
'------------------------------------------------------------------------------
    If Not blnByVoid Then blnMaxNODecrease intYear, bytPeriod, lngReceiptTypeID, strReceiptNo, lngReceiptNo
'------------------------------------------------------------------------------

    gclsBase.BaseWorkSpace.CommitTrans
    DeleteSales = True
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    Exit Function
DeleteErr:
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    gclsBase.BaseWorkSpace.RollBacktrans
    Screen.MousePointer = vbDefault
End Function

'////////////////////////////////////////////////////////////////////////////////////////
'
'                       功能代码实现
'
'////////////////////////////////////////////////////////////////////////////////////////

'删除《商品盘点表》
Public Function DeleteStockTaking(lngStockTakingID As Long, Optional blnByVoid As Boolean) As Boolean
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim strReceipt As String '盘盈、盘亏单单据号
    Dim strMsg As String
    Dim blnIsPost As Boolean '记帐标志
    Dim strDelOrVoid As String
'    Dim lngActivityID As Long '盘亏或盘盈单的ID
    Dim mclsSales As clsSales
    Dim mclsPurchase As clsPurchase
    Dim ActivityRow(5, 1) As Long
    Dim i As Integer
    Dim intYear As Integer '凭证会计年度
    Dim bytPeriod As Byte   '凭证会计期间
    Dim lngReceiptTypeID As Long
    Dim strReceiptNo As String
    Dim lngReceiptNo As Long
    On Error GoTo TheErr
    
    If blnByVoid Then
        strDelOrVoid = "作废"
    Else
        strDelOrVoid = "删除"
    End If
      
      If blnBillIsClosed(33, lngStockTakingID) Then
          ShowMsg thehWnd, "本张商品盘点表已经结帐，不能" & strDelOrVoid & "！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strDelOrVoid & "单据"
          Exit Function
      End If
    
    strSql = "SELECT * From StockTaking WHERE StockTaking.lngStockTakingID=" & lngStockTakingID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then
        Set recTemp = Nothing
        Exit Function
    End If
    intYear = recTemp!intYear
    bytPeriod = recTemp!bytPeriod
    lngReceiptTypeID = 33
    strReceiptNo = recTemp!strReceiptNo
    lngReceiptNo = recTemp!lngReceiptNo
    
    blnIsPost = (recTemp!blnIsPost <> 0)
    blnIsVoid = (recTemp!blnIsVoid <> 0)
    If recTemp!blnIsVoid = 0 And recTemp!blnIsPrinted <> 0 Then
      If BillRePrintRight(33, True) Then
          If ShowMsg(thehWnd, "本张商品盘点表已经打印，您确实要" & strDelOrVoid & "吗？", _
            MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, strDelOrVoid & "单据") = vbNo Then
            recTemp.Close
            Set recTemp = Nothing
            Exit Function
          End If
      Else
          ShowMsg thehWnd, "本张商品盘点表已经打印，不能" & strDelOrVoid & "！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strDelOrVoid & "单据"
            recTemp.Close
            Set recTemp = Nothing
            Exit Function
      End If
    End If
    Set recTemp = Nothing
    If blnIsPost Then
        If TakingBeforeDelete(lngStockTakingID, blnByVoid) = False Then Exit Function
    End If
    
    If Not blnByVoid Then   '作废操作调用删除
        If Not blnIsVoid Then
            If blnIsPost 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
        Else
           If ShowMsg(thehWnd, "您确实要删除本张已作废的商品盘点表吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
        End If
    Else
            If blnIsPost Then
                If ShowMsg(thehWnd, "本张商品盘点表已执行，作废本张商品盘点表将同时删除生成的盘盈盘亏单。 您确实要删除本张商品盘点表吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
'            Else
'                If ShowMsg(Me.hwnd, "您确实要作废本张商品盘点表吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
            End If
    End If

    If blnIsVoid Then GoTo theBegin

theBegin:
    gclsBase.BaseWorkSpace.BeginTrans
   
    If Not blnIsVoid Then
        strSql = "select ItemActivity.lngActivityID, ItemActivity.lngActivityTypeID " _
                & " from ItemActivity,itemActivityDetail   " _
                & " WHERE itemactivity.lngActivityID=ItemActivityDetail.lngActivityID " _
                & " AND ItemActivityDetail.lngOrderDetailID =" & lngStockTakingID & " GROUP BY ItemActivity.lngActivityID, ItemActivity.lngActivityTypeID "
         Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If Not recTemp.EOF Then
            recTemp.MoveFirst
            i = 0
            Do While Not recTemp.EOF
                ActivityRow(i, 0) = recTemp(0)
                ActivityRow(i, 1) = recTemp(1)
                recTemp.MoveNext
               i = i + 1
            Loop
            recTemp.Close
            Set recTemp = Nothing
            
            For i = 0 To 5
                If ActivityRow(i, 0) = 0 Then GoTo NextOne
                If ActivityRow(i, 1) = 9 Then     '已生成盘盈入库单
                    If DeletePurchase(ActivityRow(i, 0), False) = False Then GoTo TheErr
                    gclsSys.SendMessage 0, 31 + 9
                    GoTo NextOne
                ElseIf ActivityRow(i, 1) = 21 Then '已生成盘亏出库单
                    If DeleteSales(ActivityRow(i, 0), False) = False Then GoTo TheErr
                    gclsSys.SendMessage 0, 32 + 21
                    GoTo NextOne
                End If
NextOne:
            Next i
        End If
    End If
    If Not blnByVoid Then   '删除非作废单据 & 作废某张单据
        '删除盘点表
        strSql = "DELETE From StockTakingDetail WHERE (((StockTakingDetail.lngStockTakingID)=" & lngStockTakingID & "))"
        gclsBase.ExecSQL strSql
        strSql = "DELETE From StockTaking WHERE (((StockTaking.lngStockTakingID)=" & lngStockTakingID & "))"
        gclsBase.ExecSQL strSql
        blnMaxNODecrease intYear, bytPeriod, lngReceiptTypeID, strReceiptNo, lngReceiptNo
    Else                     '作废盘点表单据
        If gclsBase.ExecSQL("UPDATE StockTaking SET StockTaking.blnIsVoid = 1 ,StockTaking.blnIsPost = 0 WHERE (((StockTaking.lngStockTakingID)=" & lngStockTakingID & "))") = False Then GoTo TheErr
    End If
    
    gclsBase.BaseWorkSpace.CommitTrans
    DeleteStockTaking = True
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    Exit Function
TheErr:
   On Error Resume Next
   gclsBase.BaseWorkSpace.RollBacktrans
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    
    cMsgBox strDelOrVoid & "商品盘点表失败！"
End Function
Private Function TakingBeforeDelete(lngStockTakingID As Long, Optional blnByVoid As Boolean) As Boolean
    Dim recTmp As rdoResultset
    Dim strTmp As String
    Dim strDelOrVoid As String
    On Error GoTo TheErr
    TakingBeforeDelete = False
    If blnByVoid Then
        strDelOrVoid = "作废"
    Else
        strDelOrVoid = "删除"
    End If
    '判断对应盈亏单是否已生成凭证
    
    strTmp = " SELECT ItemActivityDetail.lngActivityDetailID,ItemActivity.lngVoucherID  " & _
            "FROM ItemActivityDetail,ItemActivity WHERE ItemActivityDetail.lngActivityID=ItemActivity.lngActivityID " & _
            " AND (((ItemActivityDetail.lngOrderDetailID) =" & lngStockTakingID & ")  AND ((ItemActivity.lngVoucherID)>0) AND ((ItemActivity.lngReceiptTypeID)=10 or(ItemActivity.lngReceiptTypeID)=23 )) "
    Set recTmp = gclsBase.BaseDB.OpenResultset(strTmp, rdOpenForwardOnly)
    If recTmp.BOF And recTmp.EOF Then
    Else
        cMsgBox "本张商品盘点表已执行，且由本张商品盘点表生成的盘盈盘亏单已生成记帐凭证，不能" & strDelOrVoid
        Set recTmp = Nothing
        Exit Function
    End If
    recTmp.Close
'判断有批次管理标志的盘赢单是否已发生了出库类型等对应业务
    strTmp = " SELECT ItemActivityDetail.lngActivityDetailID  " & _
            "FROM ItemActivityDetail,PositionItemDetail WHERE ItemActivityDetail.lngActivityDetailID=PositionItemDetail.lngInActivityDetailID " & _
            " AND (((ItemActivityDetail.lngOrderDetailID)=" & lngStockTakingID & ")  AND  ((PositionItemDetail.lngOutActivityDetailID)>0)) "
    Set recTmp = gclsBase.BaseDB.OpenResultset(strTmp, rdOpenForwardOnly)
    If recTmp.BOF And recTmp.EOF Then
    Else
        cMsgBox "本张商品盘点表已执行，且由本张商品盘点表生成的盘盈单中商品已经发生出库业务，不能" & strDelOrVoid
        Exit Function
    End If
    recTmp.Close
    If Not recTmp Is Nothing Then
        Set recTmp = Nothing
    End If
    TakingBeforeDelete = True
    Exit Function
TheErr:
    If Not recTmp Is Nothing Then
        Set recTmp = Nothing
    End If
End Function