clspurchaseorder.cls

金算盘软件代码

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsPurchaseOrder"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'蔡奇科

'采购订单

'如果采购单使用了本订单，则删除本订单应给出提示，若删除应将采购单表中的“采购订单ID”字段的值改为0


Option Explicit
Private thehWnd As Long
Private mblnIsSaveListset As Boolean                            'Whether or not save lngViewID in list

Public Sub SethWnd(arghWnd As Long)
    thehWnd = arghWnd
End Sub

Private Sub cMsgBox(strMsg As String, Optional strTitle As String)
    If Trim(strTitle) = "" Then
        strTitle = "提示信息"
    End If

    ShowMsg thehWnd, strMsg, MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strTitle
End Sub

'判断单据是否作废
Public Function IsVoid(lngPurchaseOrderID As Long) As Integer
    Dim strSql As String
    Dim recTemp As rdoResultset
    
    strSql = "SELECT PurchaseOrder.blnIsVoid FROM PurchaseOrder WHERE (((PurchaseOrder.lngPurchaseOrderID)=" & lngPurchaseOrderID & "))"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then
        cMsgBox "列表的数据已被修改，请重新刷新后再进行操作！"
        IsVoid = -1
        Set recTemp = Nothing
        Exit Function
    End If
    
    If recTemp(0) <> 0 Then
        IsVoid = 1 '作废
    Else
        IsVoid = 0 '没有作废
    End If
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
End Function

'blnByVoid：删除功能由作废调用
Public Function DeletePurchaseOrder(lngPurchaseID As Long, Optional blnByVoid As Boolean) As Boolean
    Dim strSql As String
    Dim recTemp As rdoResultset
'    Dim recTmp As rdoResultset
    Dim strMsg As String
    Dim intResult As Integer
    Dim strDelOrVoid As String
    Dim blnVoid As Boolean
    '-----------------------------------------
    Dim intYear As Integer '凭证会计年度
    Dim bytPeriod As Byte   '凭证会计期间
    Dim lngReceiptTypeID As Long
    Dim strReceiptNo As String
    Dim lngReceiptNo As Long
    '------------------------------------------
    On Error GoTo DeleteErr

    If blnByVoid Then
        strDelOrVoid = "作废"
    Else
        strDelOrVoid = "删除"
    End If

    '规则判断
    '判断是否已执行
    strSql = "SELECT Sum(PurchaseOrderDetail.dblReceiveQuantity) AS dblReceiveQuantityOfSum From PurchaseOrderDetail " _
           & " WHERE (PurchaseOrderDetail.lngPurchaseOrderID)=" & lngPurchaseID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.EOF And recTemp.BOF Then Exit Function
    
    If IsNull(recTemp(0)) = False Then
        If CDbl(recTemp(0)) > 0 Then
            If ShowMsg(thehWnd, "本张采购订单已经执行，您确实要" & strDelOrVoid & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then
                Set recTemp = Nothing
                Exit Function
            End If
        End If
    End If
    Set recTemp = Nothing
    '判断是否关闭
    strSql = "SELECT PurchaseOrderDetail.blnIsClose From PurchaseOrderDetail WHERE (PurchaseOrderDetail.blnIsClose)<>0 AND (PurchaseOrderDetail.lngPurchaseOrderID)=" & lngPurchaseID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If Not recTemp.EOF Then
        If Len(strMsg) <> 0 Then
            strMsg = strMsg & "和已经关闭的"
        Else
            strMsg = strMsg & "已经关闭的"
        End If
    End If
    Set recTemp = Nothing
    
    '判断单据已否已作废
    strSql = "SELECT PurchaseOrder.blnIsVoid,PurchaseOrder.* FROM PurchaseOrder WHERE (((PurchaseOrder.lngPurchaseOrderID)=" & lngPurchaseID & "))"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then
        cMsgBox "列表的数据已被修改，请重新刷新后再进行操作！"
        Set recTemp = Nothing
        Exit Function
    End If
    blnVoid = (recTemp(0) <> 0) '作废/没有作废
    '-------------------------------------------------------------------
    intYear = recTemp!intYear
    bytPeriod = recTemp!bytPeriod
    lngReceiptTypeID = 1
    strReceiptNo = recTemp!strReceiptNo
    lngReceiptNo = recTemp!lngReceiptNo
    '--------------------------------------------------------------------
    If blnVoid = False And recTemp!blnIsPrinted <> 0 Then
      If BillRePrintRight(1, True) Then
          If ShowMsg(thehWnd, "本张" & strMsg & "采购订单已经打印，您确实要" & strDelOrVoid & "吗？", MB_YESNO + MB_ICONQUESTION + MB_SYSTEMMODAL + MB_DEFBUTTON2, strDelOrVoid & "单据") = vbNo Then
            recTemp.Close
            Set recTemp = Nothing
            Exit Function

          End If
      Else
          ShowMsg thehWnd, "本张" & strMsg & "采购订单已经打印，不能" & strDelOrVoid & "！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, strDelOrVoid & "单据"
            recTemp.Close
            Set recTemp = Nothing
            Exit Function

      End If
    End If
    
    '提问
    If blnByVoid Then
        If blnVoid Then Exit Function
        If ShowMsg(thehWnd, "本张" & strMsg & "采购订单作废后将不能取消作废，您确实要作废吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, "提示信息") <> IDYES Then Exit Function
    Else
        If blnVoid Then
            If ShowMsg(thehWnd, "确实要删除本张已经作废的采购订单吗？", vbQuestion + vbYesNo + vbDefaultButton2, "提示信息") <> vbYes Then Exit Function
        Else
            If ShowMsg(thehWnd, "确实要删除本张" & strMsg & "采购订单吗？", vbQuestion + vbYesNo + vbDefaultButton2, "提示信息") <> vbYes Then Exit Function
        End If
    End If
    
    gclsBase.BaseWorkSpace.BeginTrans
    
    '1）单据是作废单据，不执行
    If Not blnVoid Then
        '改变《商品表》：Item中的采购在订量
        strSql = "UPDATE Item SET Item.dblPOQuantity = " & _
            " (SELECT Item.dblPOQuantity-SUM(PurchaseOrderDetail.dblQuantity-PurchaseOrderDetail.dblReceiveQuantity) " & _
            " FROM PurchaseOrderDetail WHERE PurchaseOrderDetail.lngPurchaseOrderID = " & lngPurchaseID & _
            " AND PurchaseOrderDetail.lngItemID=Item.lngItemID ) " & _
            " WHERE Item.lngItemID IN (SELECT PurchaseOrderDetail.lngItemID FROM PurchaseOrderDetail " & _
            " WHERE PurchaseOrderDetail.lngPurchaseOrderID=" & lngPurchaseID & ")"
        If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteErr
    
            
        '将采购订单表中的“采购订单ID”字段的值改为0
        strSql = "UPDATE ItemActivityDetail SET ItemActivityDetail.lngOrderDetailID = 0 " & _
            " WHERE ItemActivityDetail.lngActivityDetailID IN " & _
            " (SELECT Q1.lngActivityDetailID FROM ItemActivity,ItemActivityDetail Q1,PurchaseOrderDetail " & _
            " WHERE ItemActivity.lngActivityID = Q1.lngActivityID " & _
            " AND Q1.lngOrderDetailID = PurchaseOrderDetail.lngPurchaseOrderDetailID " & _
            " AND ItemActivity.lngActivityID IN (1,2,3) " & _
            " AND PurchaseOrderDetail.lngPurchaseOrderID=" & lngPurchaseID & ")"
        
        If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteErr
    End If

    '2）作废操作不执行
    If Not blnByVoid Then
        '删除本张采购订单
        strSql = "DELETE From PurchaseOrderDetail WHERE PurchaseOrderDetail.lngPurchaseOrderID=" & lngPurchaseID
        gclsBase.ExecSQL strSql
        strSql = "DELETE From PurchaseOrder WHERE PurchaseOrder.lngPurchaseOrderID=" & lngPurchaseID
        If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteErr
    Else
        strSql = "UPDATE PurchaseOrder SET blnIsVoid = 1 WHERE lngPurchaseOrderID=" & lngPurchaseID
        If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteErr
        strSql = "UPDATE PurchaseOrderDetail SET dblReceiveQuantity=0 WHERE lngPurchaseOrderID=" & lngPurchaseID
        If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteErr
    End If
'------------------------------------------------------------------------------
    If Not blnByVoid Then blnMaxNODecrease intYear, bytPeriod, lngReceiptTypeID, strReceiptNo, lngReceiptNo
'------------------------------------------------------------------------------
    gclsBase.BaseWorkSpace.CommitTrans
    DeletePurchaseOrder = True
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    Exit Function
DeleteErr:
    On Error Resume Next
    gclsBase.BaseWorkSpace.RollBacktrans
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    
    cMsgBox Left(strDelOrVoid, 2) & "本张采购订单时出错！”"
    
End Function