clsvouchermethod.cls

金算盘软件代码

        cMsgBox "凭证已记帐，不能修改！"
        ElseIf IsChecked Then cMsgBox "凭证已复核，不能修改！"
        ElseIf oldlngOperatorID <> gclsBase.OperatorID Then cMsgBox "不能修改别人填制的凭证！"
        ElseIf lngVoucherSourceID > 1 Then cMsgBox "不能修改机制凭证！"
        Else: cMsgBox "不能修改凭证！"
        End If
        Exit Function
    End If
    
End Function


'删除凭证
'Optional ByRef lngVoucherID_Cancel ：如果删除的凭证有冲销凭证，返回删除的冲销凭证的ID（作用：让列表不显示删除的冲销凭证）
'blnTrans：删除由通用转帐模块调用（不必进行删除权限检查）
'blnTrans1：删除通用转帐凭证
'blnByVoid：删除功能由作废调用
'blnBeginTran   起用事务标志
Public Function DeleteVoucher(lngVoucherID As Long, Optional blnNoMsg As Boolean, Optional argVoucher As String, Optional ByRef lngVoucherID_Cancel As Long, Optional blnTrans As Boolean, Optional ByVal blnByVoid As Boolean, Optional ByVal blnTrans1 As Boolean = False, Optional ByVal blnBeginTran As Boolean = True) As Boolean
    Dim strSql As String
    Dim recTemp As rdoResultset
    Dim lngSourceVoucherID As Long
    Dim lngTransVoucherID As Long  '冲销凭证的来源凭证ID 或 转帐凭证的对应转帐模板ID
    Dim i As Long
    Dim strTip As String
    Dim strDelVoid As String
    Dim strVoucherName As String
    Dim strT As String
    
    If blnTrans1 Then
        strT = "转帐凭证"
    Else
        strT = "凭证"
    End If
    strDelVoid = IIf(blnByVoid, "作废", "删除")

'    If blnByVoid Then GoTo theBegin '作废操作调用删除
    If blnTrans = True Then GoTo theBegin '跳过权限检查
    Select Case lngVoucherSourceID
        Case 2
            strVoucherName = "冲销凭证"
        Case Else
            strVoucherName = "凭证"
    End Select
    If Trim(argVoucher) = "" Then
        strTip = "本张"
    Else
        strTip = argVoucher + "号"
    End If
    
    If Not GetVoucherStatus(lngVoucherID) Then
        If blnDeleted Then
            DeleteVoucher = True
        End If
        Exit Function
    End If
    If IsClosed Then
    '期间已结帐
        cMsgBox strTip & "凭证期间的会计期间已结帐，不能" & strDelVoid & "！", strDelVoid & "凭证"
        Exit Function
    End If
    '凭证已记帐或复核,删除凭证功能应置灰
    '不能对别人填制的凭证进行删除操作
    If Not IsChecked And Not IsPosted And (oldlngOperatorID = gclsBase.OperatorID) Then
        Select Case lngVoucherSourceID
            Case 15 '记提折旧
                If DelIntperiod(lngVoucherID) = False Then
                    Exit Function
                End If
        End Select
        GoTo theDel
    Else
        '可依据情况，给出不能删除的原因
        If IsPosted Then
            If blnNoMsg = False Then cMsgBox strTip & "凭证已记帐，不能" & strDelVoid & "！", strDelVoid & "凭证"
        ElseIf IsChecked Then
            If blnNoMsg = False Then cMsgBox strTip & "凭证已复核，不能" & strDelVoid & "！", strDelVoid & "凭证"
        ElseIf oldlngOperatorID <> gclsBase.OperatorID Then
            If blnTrans1 Then
                If blnNoMsg = False Then cMsgBox "不能覆盖他人执行转帐生成的凭证！", "执行转帐凭证"
            Else    '***********
                If blnNoMsg = False Then cMsgBox "不能" & strDelVoid & "别人填制的凭证！", strDelVoid & "凭证"
            End If
        Else
            If blnNoMsg = False Then cMsgBox "不能" & strDelVoid & strTip & "凭证！"
        End If
        Exit Function
    End If
    
theDel:
      
    If blnNoMsg = False Then
        '如果删除作废的单据，应只删除单据体
        If IsCancel Then
            If ShowMsg(thehWnd, strDelVoid & strTip & "凭证将同时删除其冲销凭证" & strVoucher_Cancel & "您确实要" & strDelVoid & strTip & "凭证吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, strDelVoid & "凭证") <> IDYES Then Exit Function
        ElseIf strSourceVoucherCode <> "" Then
            If ShowMsg(thehWnd, strTip & "凭证是根据" & strSourceVoucherCode & "号凭证生成的冲销凭证，您确实要" & strDelVoid & strTip & "凭证吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, strDelVoid & "凭证") <> IDYES Then Exit Function
        End If
        If IsVoid Then
            If blnByVoid Then Exit Function
            If ShowMsg(thehWnd, "您确实要" & strDelVoid & "已经作废的" & strTip & strVoucherName & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, strDelVoid & "凭证") <> IDYES Then Exit Function
            If (Not blnTrans) And blnBeginTran Then gclsBase.BaseWorkSpace.BeginTrans
            GoTo DeleteItem
        ElseIf IsError Then '凭证有误
             If ShowMsg(thehWnd, "您确实要" & strDelVoid & "有错误标志的凭证吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, strDelVoid & "凭证") <> IDYES Then Exit Function
        '3.带"打印"标志的凭证
        ElseIf IsPrint Then
             If ShowMsg(thehWnd, "您确实要" & strDelVoid & "有打印标志的凭证吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, strDelVoid & "凭证") <> IDYES Then Exit Function
        '4.需要在下月初,进行冲销的凭证
        Else
            If blnByVoid And IsCancel = False And strSourceVoucherCode = "" Then
                If ShowMsg(thehWnd, "凭证作废后将不能取消作废，您确实要" & strDelVoid & strTip & strVoucherName & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, strDelVoid & "凭证") <> IDYES Then Exit Function
            ElseIf IsCancel = False And strSourceVoucherCode = "" Then
                If ShowMsg(thehWnd, "您确实要" & strDelVoid & strTip & strVoucherName & "吗？", MB_YESNO + MB_ICONQUESTION + MB_DEFBUTTON2 + MB_SYSTEMMODAL, strDelVoid & "凭证") <> IDYES Then Exit Function
            End If
        End If
    Else
        GoTo theBegin
    End If
''''''''''''
    If Not GetVoucherStatus(lngVoucherID) Then
        If blnDeleted Then
            DeleteVoucher = True
        End If
        Exit Function
    End If
    If IsClosed Then
    '期间已结帐
        cMsgBox strTip & "凭证期间的会计期间已结帐，不能" & strDelVoid & "！", strDelVoid & "凭证"
        Exit Function
    End If
    '凭证已记帐或复核,删除凭证功能应置灰
    '不能对别人填制的凭证进行删除操作
    If Not IsChecked And Not IsPosted And (oldlngOperatorID = gclsBase.OperatorID) Then
        GoTo theBegin
    Else
        '可依据情况，给出不能删除的原因
        If IsPosted Then
            If blnNoMsg = False Then cMsgBox strTip & "凭证已记帐，不能" & strDelVoid & "！", strDelVoid & "凭证"
        ElseIf IsChecked Then
            If blnNoMsg = False Then cMsgBox strTip & "凭证已复核，不能" & strDelVoid & "！", strDelVoid & "凭证"
        ElseIf oldlngOperatorID <> gclsBase.OperatorID Then
            If blnTrans1 Then
                If blnNoMsg = False Then cMsgBox "不能覆盖他人执行转帐生成的凭证！", "执行转帐凭证"
            Else    '***********
                If blnNoMsg = False Then cMsgBox "不能" & strDelVoid & "别人填制的凭证！", strDelVoid & "凭证"
            End If
        Else
            If blnNoMsg = False Then cMsgBox "不能" & strDelVoid & strTip & "凭证！"
        End If
        Exit Function
    End If
''''''''''''
theBegin:
On Error GoTo DeleteVoucherErr
    
    If (Not blnTrans) And blnBeginTran Then gclsBase.BaseWorkSpace.BeginTrans
    
    Select Case lngVoucherSourceID
    Case 1 '   手工
    Case 2 '删除冲销凭证
    Case 3, 4        '清除《Setting》
        If lngVoucherSourceID = 3 Then
            strSql = "DELETE From Setting WHERE strSection='损益结转' AND LTRIM(strSetting)='" & lngVoucherID & "'"
        Else
            strSql = "DELETE From Setting WHERE strSection='汇兑损益' AND LTRIM(strSetting)='" & lngVoucherID & "'"
        End If
        If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteVoucherErr
    
    Case 5, 6, 7, 8  '清除业务表：《Activity》
        strSql = "UPDATE Activity SET lngVoucherID = 0 WHERE lngVoucherID=" & lngVoucherID
        If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteVoucherErr
    
    Case 9, 10, 11   '清除商品业务表：《ItemActivity》
        strSql = "UPDATE ItemActivity SET blnNoInvoice=0," & _
                    "lngVoucherID = DECODE(lngVoucherID," & lngVoucherID & ",0 ,lngVoucherID)," & _
                    "lngVoucherID1 = DECODE(lngVoucherID1," & lngVoucherID & ",0 ,lngVoucherID1) " & _
                    " WHERE lngVoucherID=" & lngVoucherID & " OR lngVoucherID1=" & lngVoucherID
        If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteVoucherErr
        strSql = "UPDATE Activity SET lngVoucherID = 0 WHERE lngVoucherID=" & lngVoucherID
        If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteVoucherErr
    
    Case 12         '成本结转
        'cMsgBox "处理方法待定！！！"
     
    Case 15
        If DelIntperiod(lngVoucherID) = False Then GoTo DeleteVoucherErr
    Case 16         '通用转帐
        '删除的通用转帐凭证是最近生成的，应将通用转帐中的“最近生成凭证ID”TransVoucher.lngVoucherID重新设置
        '说明：lngSourceVoucherID保存转帐模板的ID（王成再在通用转帐中设置）
        
        '1）判断凭证是否是某条通用转帐模板最近生成的
        strSql = "SELECT TransVoucher.lngTransVoucherID From TransVoucher WHERE lngVoucherID=" & lngVoucherID
        Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        
        If Not recTemp.BOF Then '是最近生成
            lngTransVoucherID = recTemp(0)
            Set recTemp = Nothing
            '寻找改转帐模板另一最近生成的凭证
            strSql = "SELECT Max(lngVoucherID) AS lngVoucherIDOfMax From Voucher WHERE lngVoucherSourceID=16 AND lngSourceVoucherID=" & lngTransVoucherID & " AND lngVoucherID <>" & lngVoucherID
            Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
            If recTemp.BOF And recTemp.EOF Then
                strSql = "UPDATE TransVoucher SET lngExecutantID = 0, strExecuteDate = ' ',lngVoucherID = 0 WHERE lngTransVoucherID=" & lngTransVoucherID
            Else
                If Not IsNull(recTemp(0)) Then
                    strSql = "SELECT lngOperatorID,strDate,lngVoucherID From Voucher WHERE lngVoucherID=" & recTemp(0)

                    Set recTemp = Nothing '关闭生成最大ID的记录集
                    Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                    If recTemp.BOF And recTemp.EOF Then GoTo DeleteVoucherErr
                    strSql = "UPDATE TransVoucher SET lngExecutantID = " & recTemp(0) & ", strExecuteDate = '" & recTemp(1) & "' ,lngVoucherID =" & recTemp(2) & " WHERE lngTransVoucherID=" & lngTransVoucherID
                Else
                    strSql = "UPDATE TransVoucher SET lngExecutantID = 0, strExecuteDate = ' ',lngVoucherID = 0 WHERE lngTransVoucherID=" & lngTransVoucherID
                End If
            End If
            Set recTemp = Nothing
            If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteVoucherErr
        Else
            Set recTemp = Nothing
        End If
    End Select
    
    '改变AccountDaily 和 AccountBalance
    If Not ChangeAllAccount_from_Voucher("D", lngVoucherID) Then GoTo DeleteVoucherErr
    '删除现金流量表
    strSql = "DELETE FROM VoucherCashFlow " & _
             "WHERE lngVoucherDetailID IN (SELECT lngVoucherDetailID FROM VoucherDetail WHERE lngVoucherID=" & lngVoucherID & ")"
    If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteVoucherErr
    If gclsBase.ControlAccount = False Then
        Select Case lngVoucherSourceID
            Case 5, 6, 7, 8, 9, 10, 11
            Case Else
                If Not IsVoid Then
                    If blnDeleteCashToArap(lngVoucherID, 3, False) = False Then GoTo DeleteVoucherErr
                End If
            End Select
    End If
    If gclsBase.Trade = "邮电通信" Then
        '删除(邮电)工程开票资料
        strSql = "DELETE FROM ProjectInvoice " & _
                 "WHERE lngVoucherDetailID IN (SELECT lngVoucherDetailID FROM VoucherDetail WHERE lngVoucherID=" & lngVoucherID & ")"
    End If
    If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteVoucherErr
    '修改支票领用报销明细
    strSql = "UPDATE CheckDetail SET blnIsUsed=0,strUseDate=' ',dblCurrAmount=0,lngVoucherDetailID=0 " & _
             "WHERE lngVoucherDetailID IN (SELECT lngVoucherDetailID FROM VoucherDetail WHERE lngVoucherID=" & lngVoucherID & ")"
    If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteVoucherErr

DeleteItem:
    If Not blnByVoid Then
        '删除本张凭证
       
        strSql = "DELETE From VoucherDetail WHERE lngVoucherID=" & lngVoucherID
        If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteVoucherErr
        strSql = "DELETE From Voucher WHERE lngVoucherID=" & lngVoucherID
        If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteVoucherErr
    Else '作废
        strSql = "UPDATE Voucher SET blnIsVoid = 1,lngSourceVoucherID=0 WHERE lngVoucherID=" & lngVoucherID
        If gclsBase.ExecSQL(strSql) = False Then GoTo DeleteVoucherErr
    End If
        If Not blnByVoid Then blnMaxNODecrease intYear, bytPeriod, 41, CStr(lngVoucherTypeID), intVoucherNO
    
    If Not recTemp Is Nothing Then Set recTemp = Nothing
    '-------------------------
    If IsVoid = False Then
        If lngVoucherSourceID = 15 Then DelFixedAlterRecord intYear, bytPeriod
        If gclsBase.ControlAccount Then
            If lngVoucherSourceID = 4 Then
                strSql = "SELECT lngActivityID FROM Activity WHERE lngVoucherID=" & lngVoucherID
                Set recTemp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
                If recTemp.EOF Then
                    recTemp.Close
                    Set recTemp = Nothing
                    GoTo NoVoucher
                End If
                Dim lngActivityID() As Long
                recTemp.MoveLast
                recTemp.MoveFirst
                ReDim lngActivityID(recTemp.RowCount)
                i = 0
                Do While recTemp.EOF = False
                   lngActivityID(i) = recTemp("lngActivityID")
                   recTemp.MoveNext
                   i = i + 1
                Loop
                recTemp.Close
                Set recTemp = Nothing
                Dim clsListM As clsListMethod
                Set clsListM = New clsListMethod
                clsListM.SethWnd thehWnd
                
                For i = 0 To UBound(lngActivityID) - 1
                    If lngActivityID(i) > 0 Then
                        If clsListM.DeleteRow1(lngActivityID(i), False, False, False) = False Then
                            GoTo DeleteVoucherErr
                        End If
                    End If
                Next i
NoVoucher:
            End If
        End If
    End If
    '-----------------------
    If IsCancel Then
        '删除冲销凭证
        For i = 0 To UBound(lngCancelID) - 1
            If lngCancelID(i) > 0 Then
                If DeleteVoucher(lngCancelID(i), False, , , False, False, False, False) = False Then GoTo DeleteVoucherErr
            End If
        Next i
    End If
    
    If (Not blnTrans) And blnBeginTran Then gclsBase.BaseWorkSpace.CommitTrans
    DeleteVoucher = True
    Screen.MousePointer = vbDefault
    
    Exit Function
DeleteVoucherErr:
    Screen.MousePointer = vbDefault
    If (Not blnTrans) And blnBeginTran Then gclsBase.BaseWorkSpace.RollBacktrans
    If Not recTemp Is Nothing Then Set recTemp = Nothing
    If blnNoMsg = False Then
        cMsgBox strDelVoid & strTip & strVoucherName & "失败！", strDelVoid & "凭证"
    End If
End Function


'错误/取消错误
'lngVoucherID：要错误/取消错误的单据号
Public Function ChangeError(lngVoucherID As Long) As Boolean

    '对凭证作"错误"标志，只能由复核人或制单人执行
    '取消凭证的"错误"标志，只能由制单人取消

End Function

'复核/取消复核
Public Function ChangeCheck(lngVoucherID As Long, argVoucher As String) As Boolean
    strVoucher = argVoucher
    
    If Not GetVoucherStatus(lngVoucherID, False) Then Exit Function
    If Not IsChecked Then
        If CheckVoucher(lngVoucherID, , argVoucher) Then
            ChangeCheck = True
            '如果列表有记帐人一项，则将本凭证的的记帐人一项置为当前操作员的名字
            SetVoucherItem "复核", gclsBase.OperatorName, frmVoucherList.grdList.Row
        End If
    Else
        If UnCheckVoucher(lngVoucherID, , argVoucher) Then
            ChangeCheck = True
            '如果列表有复核人一项，则将本凭证的的复核人一项置空
            SetVoucherItem "复核", "", frmVoucherList.grdList.Row
        End If
    End If
End Function


'复核凭证
'argVoucher 凭证的名称
'blnMulti   多张复核调用时，设置为True
Public Function CheckVoucher(lngVoucherID As Long, Optional blnNoMsg As Boolean, Optional argVoucher As String, Optional blnMulti As Boolean, Optional ByVal blnGetVoucherMsg As Boolean = True) As Boolean
    Dim strSql As String