clsadjust.cls

金算盘软件代码

    Select Case IsVoucher_ItemActivity(lngActivityID)
    Case -1
        GoTo TheErr1
    Case 1
        cMsgBox "本张委托代销调拨单已经生成记帐凭证，不能" & strDelOrVoid
        DeleteLendAdjust = 0
        Exit Function
    End Select
    
    Select Case IsProduce()
    Case -1
        DeleteLendAdjust = False
        Exit Function
    Case 1
        cMsgBox "本张委托代销调拨单中的批次商品已发生过调出业务，不能" & strDelOrVoid
        DeleteLendAdjust = False
        Exit Function
    End Select
    
    strSql = "SELECT Sum(ABS(ItemActivityDetail.dblSettlementQuantity)) AS dblSettlementQuantityOfSum, " _
                 & " Sum(ABS(ItemActivityDetail.dblCurrSettlementAmount)) AS dblCurrSettlementAmountOfSum " _
                 & " FROM ItemActivityDetail Where (ItemActivityDetail.lngActivityID) = " & lngActivityID & " GROUP BY ItemActivityDetail.lngActivityID"
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.BOF And recTemp.EOF Then GoTo TheErr

    If Abs(recTemp!dblSettlementQuantityOfSum) > 10 ^ (-5) Or Abs(recTemp!dblCurrSettlementAmountOfSum) > 10 ^ (-5) Then
        Set recTemp = Nothing
        cMsgBox "本张委托代销调拨单已进行结算，不能" & strDelOrVoid
        DeleteLendAdjust = False
        Exit Function
    End If
    Set recTemp = Nothing
    
    If lngActivityIsSelected(lngActivityID) <> 0 Then
        cMsgBox "已根据本张委托代销调拨单发生其他业务（结算、开票等），不能" & strDelOrVoid
        DeleteLendAdjust = False
        Exit Function
    End If
    
    '提问
    If blnNoAlert = False Then
      If blnByVoid 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
    
'''    strSql = "SELECT * From ItemActivity WHERE (lngActivityID)=" & lngActivityID
'''    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
'''    If recTemp.EOF Then
'''        cMsgBox "列表的数据已被修改，请重新刷新后再进行操作！"
'''        Set recTemp = Nothing
'''        Exit Function
'''    End If
'''    '判断单据已否已作废
'''    blnVoid = (recTemp!blnIsVoid <> 0)
'''    '-------------------------------------------------------------------
'''    intYear = gclsBase.FYearOfDate(C2Date(recTemp!strDate))
'''    bytPeriod = gclsBase.PeriodOfDate(C2Date(recTemp!strDate))
'''    lngReceiptTypeID = recTemp!lngReceiptTypeID
'''    strReceiptNo = LTrim(recTemp!strReceiptNo)
'''    lngReceiptNo = recTemp!lngReceiptNo
'''    '--------------------------------------------------------------------
'''    recTemp.Close
'''    Set recTemp = Nothing
    gclsBase.BaseWorkSpace.BeginTrans
    On Error GoTo TheErr
    
       '找到本条代销调入对应的代销调出的ID
'       strSql = "SELECT ItemActivity.lngActivityID FROM ItemActivity INNER JOIN ItemActivity AS ItemActivity_1 ON (ItemActivity.lngReceiptNO = ItemActivity_1.lngReceiptNO) AND (ItemActivity.strReceiptNO = ItemActivity_1.strReceiptNO) AND (ItemActivity.lngReceiptTypeID = ItemActivity_1.lngReceiptTypeID)" _
'              & " WHERE (((ItemActivity_1.lngActivityID)=" & lngActivityID & ") AND ((ItemActivity.lngActivityTypeID)=25))"
       strSql = "SELECT ItemActivity.lngActivityID FROM ItemActivity,ItemActivity ItemActivity_1" & _
                " WHERE ItemActivity.lngReceiptNO = ItemActivity_1.lngReceiptNO" & _
                " AND ItemActivity.strReceiptNO = ItemActivity_1.strReceiptNO" & _
                " AND ItemActivity.strDate = ItemActivity_1.strDate" & _
                " AND ItemActivity.lngReceiptTypeID = ItemActivity_1.lngReceiptTypeID" & _
                " AND ItemActivity_1.lngActivityID=" & lngActivityID & " AND ItemActivity.lngActivityTypeID=25"
       Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
       If recTemp.BOF And recTemp.EOF Then Exit Function
       lngActivityID_OUT = recTemp(0)
       Set recTemp = Nothing
        
   
    '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 DeleteRelation(lngActivityID_OUT, 25, thehWnd) <> 1 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-ItemActivity.blnIsVoid) " _
              & " 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
    DeleteLendAdjust = True
    Exit Function
TheErr:
    On Error Resume Next
    gclsBase.BaseWorkSpace.RollBacktrans
TheErr1:
    If Not recTemp Is Nothing Then
        Set recTemp = Nothing
    End If
    cMsgBox Left(strDelOrVoid, 2) & "代销调拨单失败！"
End Function



'*****************************************代销调价*****************************************
Public Function DeleteLendAdjustPrice(arglngActivityID As Long, Optional blnByVoid As Boolean) As Boolean
    Dim strSql As String
    Dim intResult As Integer
    Dim strDelOrVoid As String
    Dim blnVoid As Boolean
On Error GoTo TheErr

    If blnByVoid Then
        strDelOrVoid = "作废！"
    Else
        strDelOrVoid = "删除！"
    End If
    
    lngActivityID = arglngActivityID
     
     '规则判断
    Select Case IsVoucher_ItemActivity(lngActivityID)
    Case -1
        GoTo TheErr
    Case 1
        cMsgBox "本张代销调价单已经生成记帐凭证，不能" & strDelOrVoid
        DeleteLendAdjustPrice = 0
        Exit Function
    End Select
    
    '判断单据已否已作废
    intResult = IsVoid(lngActivityID)
    If intResult = -1 Then Exit Function
    If intResult = 1 Then
        blnVoid = True
    End If
    
    '提问
    If blnByVoid Then
        If blnVoid Then Exit Function
        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
   
    '1）单据是作废单据，不执行
    If Not blnVoid Then
        If ChangeAllItem_from_Activity("D", lngActivityID) = False Then GoTo TheErr
    End If
    
    '2）作废操作不执行
    If Not blnByVoid Then
        If DeleteItemActivityANDItemActivityDetail(lngActivityID) <> 0 Then GoTo TheErr
    Else
        strSql = "UPDATE ItemActivity SET ItemActivity.blnIsVoid = (1-ItemActivity.blnIsVoid) WHERE (((ItemActivity.lngActivityID)=" & lngActivityID & "))"
        If gclsBase.ExecSQL(strSql) = False Then GoTo TheErr
    End If
    
    gclsBase.BaseWorkSpace.CommitTrans
    DeleteLendAdjustPrice = True
    Exit Function
TheErr:
    gclsBase.BaseWorkSpace.RollBacktrans
    cMsgBox Left(strDelOrVoid, 2) & "代销调价单失败！"
End Function



'*****************************************商品调拨*****************************************
'arglngActivityID 为调入的ID
Public Function DeleteAdjust(arglngActivityID As Long, Optional blnByVoid As Boolean) As Boolean
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim lngActivityID_OUT As Long
    Dim intResult As Integer
    Dim strDelOrVoid As String
    Dim blnVoid As Boolean
    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
        cMsgBox "本张商品调拨已经生成记帐凭证，不能" & strDelOrVoid
        DeleteAdjust = 0
        Exit Function
    End Select
    
    Select Case IsProduce()
    Case -1
        DeleteAdjust = False
        Exit Function
    Case 1
        cMsgBox "本张商品调拨单中的批次商品已发生过调出业务，不能" & strDelOrVoid
        DeleteAdjust = False
        Exit Function
    End Select
   
    strSql = "SELECT * From ItemActivity WHERE (lngActivityID)=" & lngActivityID
    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
    If recTemp.EOF Then
        DeleteAdjust = True
        Set recTemp = Nothing
        Exit Function
    End If