frmwriteoffbill.frm

金算盘软件代码

    recTmp.Close
    Set recTmp = Nothing
End Sub
Private Function blnBillCanWriteOff(ByVal lngFormHwnd As Long) As Boolean
    Dim strSql As String
    Dim recTmp As rdoResultset
    Dim strName As String
    
    blnBillCanWriteOff = False
    If my_lngReceiptTypeID = 41 Then
        strName = "凭证"
    Else
        strName = "单据"
    End If
    '权限判断
    Select Case my_lngReceiptTypeID
    Case 1, 10, 12, 23, 26, 27, 28, 29, 30, 31, 32, 33
    Case 34, 35
        If Not IsCanDo(EditNO(my_lngReceiptTypeID)) Then
            If lngFormHwnd <> 0 Then
                ShowMsg lngFormHwnd, "您没有冲销应付单单据的权限！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
            End If
            GoTo Check_Err
        End If
    Case 36, 37
        If Not IsCanDo(EditNO(my_lngReceiptTypeID)) Then
            If lngFormHwnd <> 0 Then
                ShowMsg lngFormHwnd, "您没有冲销应收单单据的权限！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
            End If
            GoTo Check_Err
        End If
    Case 38
        If Not IsCanDo(EditNO(my_lngReceiptTypeID)) Then
            If lngFormHwnd <> 0 Then
                ShowMsg lngFormHwnd, "您没有冲销应收计息单据的权限！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
            End If
            GoTo Check_Err
        End If
    Case Else
        If my_blnIsSpecial Then
            If my_lngReceiptTypeID = 39 Then
               If Not IsCanDo(471) Then
                    If lngFormHwnd <> 0 Then
                        ShowMsg lngFormHwnd, "您没有冲销采购付款单据的权限！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
                        GoTo Check_Err
                    End If
                End If
            Else
                If Not IsCanDo(469) Then
                    If lngFormHwnd <> 0 Then
                        ShowMsg lngFormHwnd, "您没有冲销销售收款单据的权限！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
                        GoTo Check_Err
                    End If
                End If
            End If
        Else
            strSql = "SELECT strReceiptTypeName FROM ReceiptType WHERE lngReceiptTypeID=" & my_lngReceiptTypeID
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
            If Not IsCanDo(EditNO(my_lngReceiptTypeID)) Then
                #If conVersionType = 16 Then '财务版
                    If my_lngReceiptTypeID = 2 Then
                        If lngFormHwnd <> 0 Then
                            ShowMsg lngFormHwnd, "您没有冲销采购发票单据的权限！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
                        End If
                    ElseIf my_lngReceiptTypeID = 12 Then
                        If lngFormHwnd <> 0 Then
                            ShowMsg lngFormHwnd, "您没有冲销销售发票单据的权限！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
                        End If
                    Else
                        If lngFormHwnd <> 0 Then
                            ShowMsg lngFormHwnd, "您没有冲销" & recTmp!strReceiptTypeName & "单据的权限！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
                        End If
                    End If
                #Else
                    If lngFormHwnd <> 0 Then
                        ShowMsg lngFormHwnd, "您没有冲销" & recTmp!strReceiptTypeName & "单据的权限！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
                    End If
                #End If
                GoTo Check_Err
            End If
        End If
    End Select
    
    Select Case my_lngReceiptTypeID
    Case 1, 10, 12, 23, 26, 27, 28, 29, 30, 31, 32, 33
        If lngFormHwnd <> 0 Then
            ShowMsg lngFormHwnd, "本类型的单据不能生成冲销单据！", MB_OK + MB_SYSTEMMODAL + MB_ICONEXCLAMATION, Me.Caption
        End If
        GoTo Check_Err
    Case 2 To 24
        If my_lngActivityID = 0 Then
            GoTo Check_OK
        End If
        
        If my_lngReceiptTypeID = 22 Then
            If blnCostAdjustIsAuto(my_lngActivityID) = True Then
               If ShowMsg(lngFormHwnd, "本张成本调整单由系统自动生成，不能冲销，您是否要冲销其他单据？", MB_YESNO + MB_SYSTEMMODAL + MB_DEFBUTTON2 + MB_ICONQUESTION) = vbYes Then
                  GoTo Check_OK
               Else
                  GoTo Check_Err
               End If
            End If
        End If
        
'        strSql = "SELECT ItemActivity.lngSourceActivityID,ItemActivity.blnIsVoid,ItemActivity_1.strDate," _
'        & "ItemActivity_1.strReceiptNO,ItemActivity_1.lngReceiptNO,1 FROM ItemActivity LEFT JOIN ItemActivity AS ItemActivity_1 " _
'        & " ON ItemActivity.lngSourceActivityID=ItemActivity_1.lngActivityID WHERE ItemActivity.lngActivityID=" & my_lngActivityID
        strSql = "SELECT ItemActivity.lngSourceActivityID,ItemActivity.blnIsVoid,ItemActivity_1.strDate," _
        & "ItemActivity_1.strReceiptNO,ItemActivity_1.lngReceiptNO,1 FROM ItemActivity,ItemActivity ItemActivity_1 " _
        & " WHERE ItemActivity.lngSourceActivityID=ItemActivity_1.lngActivityID(+) AND ItemActivity.lngActivityID=" & my_lngActivityID
    Case 34 To 40
        If my_lngActivityID = 0 Then
            GoTo Check_OK
        End If
'        strSql = "SELECT Activity.lngSourceActivityID,Activity.blnIsVoid,Activity_1.strDate," _
'        & "Activity_1.strReceiptNO,Activity_1.lngReceiptNO,1 FROM Activity LEFT JOIN Activity AS Activity_1 " _
'        & " ON Activity.lngSourceActivityID=Activity_1.lngActivityID WHERE Activity.lngActivityID=" & my_lngActivityID
        strSql = "SELECT Activity.lngSourceActivityID,Activity.blnIsVoid,Activity_1.strDate," _
        & "Activity_1.strReceiptNO,Activity_1.lngReceiptNO,1,Activity.blnIsDiscount FROM Activity, Activity Activity_1 " _
        & " WHERE Activity.lngSourceActivityID=Activity_1.lngActivityID(+) AND Activity.lngActivityID=" & my_lngActivityID
    Case 41
        Dim lngVoucherTypeID As Long
        
        lngVoucherTypeID = my_lngVoucherTypeID
        If lngVoucherTypeID = 0 Then
            If my_lngActivityID <> 0 Then
                strSql = "SELECT lngVoucherTypeID FROM Voucher WHERE lngVoucherID=" & my_lngActivityID
                Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
                If recTmp.BOF And recTmp.EOF Then
                Else
                    lngVoucherTypeID = recTmp!lngVoucherTypeID
                End If
                recTmp.Close
                Set recTmp = Nothing
            End If
        End If
        If lngVoucherTypeID <> 0 Then
            strSql = "SELECT strVoucherTypeName,lngVoucherTypeID FROM VoucherType WHERE blnIsInActive=0 and lngVoucherTypeID =" & lngVoucherTypeID
            Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
            If Not (recTmp.BOF And recTmp.EOF) Then
                recTmp.Close
                Set recTmp = Nothing
                GoTo CheckVoucherType_OK
            Else
                recTmp.Close
                Set recTmp = Nothing
                If lngFormHwnd <> 0 Then
                    If ShowMsg(lngFormHwnd, "本凭证的凭证类型已停用，您是否要继续冲销？", MB_YESNO + MB_SYSTEMMODAL + MB_DEFBUTTON2 + MB_ICONQUESTION, "冲销" & strName) = vbNo Then
                        GoTo Check_Err
                    End If
                End If
            End If
        End If
        strSql = "SELECT lngVoucherTypeID FROM VoucherType WHERE blnIsInActive=0"
        Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenStatic)
        If recTmp.BOF And recTmp.EOF Then
            If ShowMsg(lngFormHwnd, "没有可用的凭证类型，您是否要继续冲销？", MB_YESNO + MB_SYSTEMMODAL + MB_DEFBUTTON2 + MB_ICONQUESTION, "冲销" & strName) = vbNo Then
                GoTo Check_Err
            End If
        End If
        recTmp.Close
        Set recTmp = Nothing
CheckVoucherType_OK:
        If my_lngActivityID = 0 Then
            GoTo Check_OK
        End If
'        strSql = "SELECT Voucher.lngSourceVoucherID,Voucher.blnIsVoid,Voucher_1.strDate," _
'            & "'',Voucher_1.intVoucherNO,Voucher.lngVoucherSourceID FROM Voucher LEFT JOIN Voucher AS Voucher_1 " _
'            & " ON Voucher.lngSourceVoucherID=Voucher_1.lngVoucherID WHERE Voucher.lngVoucherID=" & my_lngActivityID
        strSql = "SELECT Voucher.lngSourceVoucherID,Voucher.blnIsVoid,Voucher_1.strDate," _
            & "'',Voucher_1.intVoucherNO,Voucher.lngVoucherSourceID FROM Voucher,Voucher Voucher_1 " _
            & " WHERE Voucher.lngSourceVoucherID=Voucher_1.lngVoucherID(+) AND Voucher.lngVoucherID=" & my_lngActivityID
    End Select
    Set recTmp = gclsBase.BaseDB.OpenResultset(strSql, rdOpenForwardOnly)
    If recTmp.BOF And recTmp.EOF Then
        If lngFormHwnd <> 0 Then
            If ShowMsg(lngFormHwnd, "本" & strName & "已被删除，不能生成冲销" & strName & "！您是否要冲销其它" & strName & "？", MB_YESNO + MB_SYSTEMMODAL + MB_DEFBUTTON2 + MB_ICONQUESTION, "冲销" & strName) = vbNo Then
                GoTo Check_Err
            End If
        Else
            GoTo Check_Err
        End If
        GoTo Check_OK
    End If
    If recTmp(1) <> 0 Then
        If lngFormHwnd <> 0 Then
            If ShowMsg(lngFormHwnd, "本" & strName & "已作废，不能生成冲销" & strName & "！您是否要冲销其它" & strName & "？", MB_YESNO + MB_SYSTEMMODAL + MB_DEFBUTTON2 + MB_ICONQUESTION, "冲销" & strName) = vbNo Then
                GoTo Check_Err
            End If
        Else
            GoTo Check_Err
        End If
        GoTo Check_OK
    End If
    If recTmp(5) <> 1 Then
        If lngFormHwnd <> 0 Then
            If ShowMsg(lngFormHwnd, "本凭证不是手工录入，不能生成冲销凭证！您是否要冲销其它凭证？", MB_YESNO + MB_SYSTEMMODAL + MB_DEFBUTTON2 + MB_ICONQUESTION, "冲销" & strName) = vbNo Then
                GoTo Check_Err
            End If
        Else
            GoTo Check_Err
        End If
        GoTo Check_OK
    End If
    If recTmp(0) <> 0 Then
        If lngFormHwnd <> 0 Then
            If ShowMsg(lngFormHwnd, "本" & strName & "是根据" & CStr(gclsBase.FYearOfDate(CDate(recTmp(2)))) & "-" & Format(gclsBase.PeriodOfDate(CDate(recTmp(2))), "00") & _
            "-" & recTmp(3) & Format(recTmp(4), "0000") & "号" & strName & "生成的冲销" & strName & "，不能被冲销！您是否要冲销其它" & strName & "？", MB_YESNO + MB_SYSTEMMODAL + MB_DEFBUTTON2 + MB_ICONQUESTION, "冲销" & strName) = vbNo Then
                GoTo Check_Err
            End If
        Else
            GoTo Check_Err
        End If
        GoTo Check_OK
    End If
    '折扣单据特殊判断
    If my_lngReceiptTypeID > 33 And my_lngReceiptTypeID < 41 Then
      If recTmp!blnIsDiscount <> 0 Then
        If lngFormHwnd <> 0 Then
            If ShowMsg(lngFormHwnd, "本" & strName & "是自动生成的折扣单据，不能被冲销！您是否要冲销其它" & strName & "？", MB_YESNO + MB_SYSTEMMODAL + MB_DEFBUTTON2 + MB_ICONQUESTION, "冲销" & strName) = vbNo Then
                GoTo Check_Err
            End If
        Else
            GoTo Check_Err
        End If
        GoTo Check_OK
      End If
    End If
Check_OK:
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    blnBillCanWriteOff = True
    Exit Function
Check_Err:
    If Not recTmp Is Nothing Then
        recTmp.Close
        Set recTmp = Nothing
    End If
    blnBillCanWriteOff = False
End Function

Private Sub Form_KeyPress(KeyAscii As Integer)
    On Error Resume Next
    If KeyAscii = 13 Then
        If Not Me.ActiveControl Is cmdOK Then
            BKKEY Me.ActiveControl.hWnd, vbKeyTab
        End If
    End If
End Sub

Private Sub lstNO_Validate(Cancel As Boolean)
    lstNO.MoveFocus
    lstNO.Text = Trim(lstNO.Text)
    If lstNO.Text <> "" And lstNO.ID = 0 Then
        If lstNO.Text <> "" Then
            ShowMsg Me.hWnd, "期间(" & cmbSelect(0).Text & "-" & cmbSelect(1).Text & ")没有单据号为" & _
                lstNO.Text & "的" & mstrName & "！", MB_OK + MB_ICONEXCLAMATION + MB_SYSTEMMODAL, Me.Caption
        End If
        Cancel = True
        On Error Resume Next
        lstNO.ReferRow = 0
        If lstNO.ID = 0 Then
            lstNO.Text = ""
        End If
    End If
End Sub