📄 +
字号:
'1.2进行其他有效性判断,编写格式同1.1
'2.放置行处理程序(当数据行通过有效性判断)
'以上为自定义部分<<]
End With 'WglrGrid
'如果此行通过行有效性判断则加锁,直至此行数据再次发生变化
Sjhzyxxpd = True
Hyxxpdlock = True
Exit Function
Lrcwcl: '录入错误处理
With WglrGrid
'给出错误提示信息
Call Xtxxts(Tsxx, 0, 1)
'返回网格错误位置 (ChangeLock避免再次引发RowColChange有效性判断), 装入录入载体
changelock = True
.Select Yxxpdh, Lrywlz
changelock = False
Call xswbk
'函数返回False
Sjhzyxxpd = False
Exit Function
End With
End Function
Private Function Sub_SaveBill() As Boolean '保 存 单 据
Dim RecTemp As New ADODB.Recordset '临时使用动态集
Dim Rec_VouchMain As New ADODB.Recordset '单据主表动态集
Dim Rec_VouchSub As New ADODB.Recordset '单据子表动态集
Dim Rowjsq As Long '网格行计数器
Dim Coljsq As Long '网格列计数器
Dim jsqte As Integer '临时计数器
Dim Lng_RowCount As Long '有效数据行计数器
Dim Lrywlz As Long '录入有误列值
Dim TotalShje As Single '汇总收回金额
Dim Rec_BadDebt As New ADODB.Recordset '回写坏帐发生动态集
Dim Rec_AccList As New ADODB.Recordset '回写应收明细帐
Dim BadID As Integer '坏帐标识ID
Dim Rec_AccListAdd As New ADODB.Recordset '临时使用动态集(追加记录)
Dim Rec_AccSum As New ADODB.Recordset '临时动态集(追加总帐)
Dim Str_PSCode As String '客户编码
Dim Str_DeptCode As String '部门编码
Dim Str_PersonCode As String '经办人编码
Dim Str_ForeignCurrCode As String '币别编码
Dim Rec_TempPd As New ADODB.Recordset '判断坏帐损失和收款单上的客户是否一致
Sub_SaveBill = False
'一.============先对单据内容进行有效性判断==============='
'坏帐损失客户和收款单的客户是否相同,如果不一致,则不能进行坏帐收回处理
If Trim((LrText(0).Text) & "") <> "" Then
Set Rec_TempPd = Cw_DataEnvi.DataConnect.Execute("Select BillCode From RP_AccList Where BillCode='" & Trim((LrText(0).Text) & "") & "' and PsCode='" & Trim((LrText(1).Tag) & "") & "'")
If Not Rec_TempPd.EOF Then
If Trim(Rec_TempPd.Fields("BillCode") & "") = "" Then
Tsxx = "收款单和坏帐损失的客户不一致,请重新输入收款单!!"
Call Xtxxts(Tsxx, 0, 1)
LrText(0).SetFocus
Exit Function
End If
End If
End If
'先进行字段不能为空或不能为零有效性判断(Fixed)
For jsqte = 0 To Max_Text_Index
If Textint(jsqte, 8) = 1 Then '字段不能为空
If Len(Trim(LrText(jsqte).Text)) = 0 Then
Tsxx = Textstr(jsqte, 7) & "不能为空!"
Call Xtxxts(Tsxx, 0, 1)
LrText(jsqte).SetFocus
Exit Function
End If
Else
If Textint(jsqte, 8) = 2 Then '字段不能为零
If Val(Trim(LrText(jsqte).Text)) = 0 Then
Tsxx = Textstr(jsqte, 7) & "不能为零!"
Call Xtxxts(Tsxx, 0, 1)
LrText(jsqte).SetFocus
Exit Function
End If
End If
End If
Next jsqte
'对需要进行事后判断的文本框录入内容进行有效性判断 (Fixed)
For jsqte = 0 To Max_Text_Index
If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
If Not TextYxxpd(jsqte) Then
Call TextShow(jsqte)
Exit Function
End If
End If
Next jsqte
'判断币别是否相同,如果不同,则不能进行坏帐收回处理
With WglrGrid
For Rowjsq = .FixedRows To .Rows - 1
If .TextMatrix(Rowjsq, 0) = "*" And .TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = True Then
If Trim(LrText(2).Tag) <> Trim(.TextMatrix(Rowjsq, Sydz("004", GridStr(), Szzls))) Then
Tsxx = "币别不相同,不能进行坏帐收回处理!"
Call Xtxxts(Tsxx, 0, 1)
Exit Function
End If
End If
Next Rowjsq
End With
'判断收款金额是否大于收款余额
TotalShje = 0
For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
'带*号者为有效数据行(Fixed)
If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
Exit For
Else
If WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = True Then
TotalShje = TotalShje + WglrGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls))
End If
End If
Next Rowjsq
If Val(LrText(5).Tag) < Val(LrText(5).Text) Then
Tsxx = "收款金额不能大于收款单上的金额!"
Call Xtxxts(Tsxx, 0, 1)
LrText(5).SetFocus
Exit Function
End If
If Val(LrText(5).Text) <> TotalShje Then
Tsxx = "坏帐收回金额不等于收款金额!"
Call Xtxxts(Tsxx, 0, 1)
LrText(5).SetFocus
Exit Function
End If
'判断单据日期是否有效,如果单据日期所在的会计期间已经结帐,则不能保存
If Not Fun_GetPeriod(CDate(Format(LrText(6).Text, "yyyy-mm-dd")), Int_Kjyear, Int_Period) Then
LrText(6).SetFocus
Exit Function
End If
'[>>
'可在此区域写入其他对单据表头内容的有效性判断.
'<<]
'[>>下面将对所有有效数据行进行有效性判断
Lng_RowCount = 0
With WglrGrid
For Rowjsq = .FixedRows To .Rows - 1
'带*号者为有效数据行(Fixed)
If .TextMatrix(Rowjsq, 0) <> "*" And .TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = True Then
Exit For
Else
Lng_RowCount = Lng_RowCount + 1
End If
'1.首先进行为空或为零判断(Fixed)
For jsqte = Qslz To .Cols - 1
'字段不能为空
If GridInt(jsqte, 5) = 1 Then
If Len(Trim(.TextMatrix(Rowjsq, jsqte))) = 0 Then
Tsxx = GridStr(jsqte, 2)
Lrywlz = jsqte
GoTo Lrcwcl
Exit For
End If
End If
'字段不能为零
If GridInt(jsqte, 5) = 2 Then
If Val(Trim(.TextMatrix(Rowjsq, jsqte))) = 0 Then
Tsxx = GridStr(jsqte, 2)
Lrywlz = jsqte
GoTo Lrcwcl
Exit For
End If
End If
Next jsqte
'2.判断存货编码是否存在(Define)
Next Rowjsq
'单据分录行数不能为零(Fixed)
If Lng_RowCount = 0 Then
Tsxx = "没有进行坏帐收回处理,不能保存!"
Call Xtxxts(Tsxx, 0, 1)
Exit Function
End If
'[>>
'此处可以定义整张单据不能通过有效性检查的理由
'<<]
End With '网格
If Sub_Run = False Then
Exit Function
End If
'二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
'对存盘进行事务处理(Fixed)
On Error GoTo Swcwcl
Cw_DataEnvi.DataConnect.BeginTrans
'判断单据状态以进行不同处理
'1.先对单据主表进行处理
'2.对单据子表进行处理
'打开单据子表动态集
If Rec_VouchSub.State = 1 Then Rec_VouchSub.Close
Rec_VouchSub.Open "Select * From RP_BadDebt Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
'将网格中有效数据行写入单据子表
For Rowjsq = WglrGrid.FixedRows To WglrGrid.Rows - 1
If WglrGrid.TextMatrix(Rowjsq, 0) <> "*" Then
Exit For
End If
If WglrGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), Szzls)) = True Then
With Rec_VouchSub
.AddNew
.Fields("PsCode") = Trim(LrText(1).Tag) '客户编码
.Fields("BillCode") = Trim(LrText(0).Text) '结算单号
.Fields("DeptCode") = Trim((LrText(3).Tag) & "") '部门
.Fields("PersonCode") = Trim((LrText(4).Tag) & "") '经办人
.Fields("BillDate") = Format(WglrGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), Szzls)), "yyyy-mm-dd") '坏帐发生日期
.Fields("DebtDate") = Format(LrText(6).Text, "yyyy-mm-dd") '坏帐收回日期
.Fields("KjYear") = Int_Kjyear '会计年度
.Fields("Period") = Int_Period '会计期间
.Fields("ForeignCurrCode") = Trim((LrText(2).Tag) & "") '币别
.Fields("AccRate") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("007", GridStr(), Szzls))) '原币坏帐金额
.Fields("YbSsje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("008", GridStr(), Szzls))) '汇率
.Fields("BbSsje") = Val(WglrGrid.TextMatrix(Rowjsq, Sydz("009", GridStr(), Szzls))) '本币坏帐金额
.Fields("Digest") = Trim((LrText(7).Text) & "") '摘要
If Fun_GetAccInformation("AR_baddebtsMothed") = 1 Then
.Fields("AccCode") = Fun_GetInputCode("AR_BadDebtPrepAccCode") '坏帐准备科目(备抵法)
Else
.Fields("AccCode") = Fun_GetInputCode("AR_BadDebtAccCode") '坏帐损失科目(非备抵法)
End If
.Fields("AccCodeArAp") = Trim(WglrGrid.TextMatrix(Rowjsq, Sydz("010", GridStr(), Szzls))) '应收科目编码
'输出单据类型
.Fields("BadItemCode") = "61"
.Update
End With
'将坏帐收回金额回写到坏帐文件
BadID = WglrGrid.TextMatrix(Rowjsq, Sydz("011", GridStr(), Szzls))
With Rec_BadDebt
If .State = 1 Then .Close
.Open "Select * From RP_BadDebt Where BadDebtId=" & BadID, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not Rec_BadDebt.EOF Then
.Fields("YbSsje") = .Fields("YbSsje") + Rec_VouchSub.Fields("YbSsje") '原币坏帐收回金额
.Fields("BbSsje") = .Fields("BbSsje") + Rec_VouchSub.Fields("BbSsje") '本币坏帐收回余额
'判断是否全部收回坏帐
If Val(.Fields("YbYsje")) = Val(.Fields("YbSsje")) Then
.Fields("BackFlag") = 1
End If
.Update
End If
End With
'将收回坏帐回写到应收明细帐(收款单)
With Rec_AccList
If .State = 1 Then .Close
.Open "Select * From RP_AccList Where BillCode='" & Trim(LrText(0).Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not Rec_AccList.EOF Then
.Fields("YbCancelje") = .Fields("YbCancelje") + Rec_VouchSub.Fields("YbSsje") '核销原币金额
.Fields("BbCancelje") = .Fields("BbCancelje") + Rec_VouchSub.Fields("BbSsje") '核销本币金额
'判断是否全部收回坏帐
If Val(.Fields("YbSsje")) = Val(.Fields("YbCancelje")) Then
.Fields("OverStatus") = 1
End If
.Update
End If
End With
'根据确定的坏帐收回记录登记到应收明细帐(其它应收)
With Rec_AccListAdd
If .State = 1 Then .Close
.Open "Select * From RP_AccList", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
.AddNew
.Fields("RPFlag") = "Ar" '应收/应付标识
.Fields("PsCode") = Trim(Rec_VouchSub.Fields("PsCode")) '客户编码
.Fields("BillDate") = Xtrq '单据日期
.Fields("KjYear") = Int_Kjyear '会计年度
.Fields("Period") = Int_Period '会计期间
.Fields("BillItemCode") = "61"
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -