📄
字号:
For jsqte = .FixedRows To .Rows - 1
CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = True
.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = .TextMatrix(jsqte, Sydz("007", GridStr(), Szzls))
Next jsqte
End With
With CxbbGrid1
For jsqte = .FixedRows To .Rows - 1
If Dbl_Yskhj <> 0 Then
CxbbGrid1.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = True
If Dbl_Yskhj > Val(.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls))) Then
.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = .TextMatrix(jsqte, Sydz("007", GridStr(), Szzls))
Else
.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = Dbl_Yskhj
End If
Dbl_Yskhj = Dbl_Yskhj - Val(.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)))
End If
Next jsqte
End With
End If
End Sub
Private Sub Sub_Sghx() '手工核销
Select Case Int_Hxlx
Case 0, 1 '到款结算、预收款冲应收款
If Fun_Dkjs(Int_Hxlx) Then
Call Timer1_Timer
End If
Case 2
If Fun_YsCYf Then
Call Timer1_Timer
End If
End Select
End Sub
Private Function Fun_Dkjs(Int_Hxlx As Integer) As Boolean '到款结算
'函数参数:Int_Hxlx 核销类型 0-到款结算 1-预收款冲应收款
Dim Rec_AccList As New ADODB.Recordset '应收/应付明细帐
Dim Rec_Cancel As New ADODB.Recordset '应收/应付核销情况表
Dim RecTemp As New ADODB.Recordset '临时动态集
Dim Dbl_Phjg As Double '平衡结果
Dim Dbl_Phjg1 As Double '平衡结果1
Dim jsqte As Long '临时计数器
Dim Bln_Select As Boolean '是否选中核销单据
Dim Sqlstr As String '查询连接串
Dim Bln_ConVertFlag As Boolean '折算方式
Dim Lng_CancelNo As Long '核销过程序号
Dim Dbl_CWbje As Double '核销原币金额
Dim Dbl_CBbje As Double '核销本币金额
Bln_Select = False
'让录入充分完成
CxbbGrid.Col = 0
CxbbGrid1.Col = 0
Dbl_Phjg = 0
Dbl_Phjg1 = 0
'先判断用户输入核销金额是否平衡
With CxbbGrid
For jsqte = .FixedRows To .Rows - 1
If .TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = True Then
Bln_Select = True
Dbl_Phjg = Dbl_Phjg + Val(.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)))
End If
Next jsqte
End With
With CxbbGrid1
For jsqte = .FixedRows To .Rows - 1
If .TextMatrix(jsqte, Sydz("002", GridStr1(), Szzls1)) = True Then
Bln_Select = True
Dbl_Phjg1 = Dbl_Phjg1 + Val(.TextMatrix(jsqte, Sydz("008", GridStr1(), Szzls1)))
End If
Next jsqte
End With
If Not Bln_Select Then
Tsxx = "请先选中核销记录!"
Call Xtxxts(Tsxx, 0, 4)
Exit Function
End If
If Abs(Dbl_Phjg - Dbl_Phjg1) >= 0.001 Then
Tsxx = "核销金额不平衡,不能进行核销!"
Call Xtxxts(Tsxx, 0, 4)
Exit Function
End If
'开始进行核销
On Error GoTo Swcwcl
Cw_DataEnvi.DataConnect.BeginTrans
'取最大核销过程序号
Sqlstr = "Select Max(CancelNo) as MaxCancelNo From RP_Cancel Where RpFlag='AR'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
If Not IsNull(RecTemp.Fields("MaxCancelNo")) Then
Lng_CancelNo = RecTemp.Fields("MaxCancelNo") + 1
Else
Lng_CancelNo = 1
End If
'1.核销应收/应付款明细帐
With CxbbGrid
For jsqte = .FixedRows To .Rows - 1
If .TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = True Then
With Rec_AccList
If Rec_AccList.State = 1 Then .Close
Sqlstr = "Select RP_Acclist.* From RP_AccList" & _
" Where AcclistID = " & Val(CxbbGrid.TextMatrix(jsqte, 0))
Rec_AccList.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
Sqlstr = "Select Gy_ForeignCurrency.ConVertFlag From Gy_ForeignCurrency Where Gy_ForeignCurrency.ForeignCurrCode='" & Trim(.Fields("ForeignCurrCode")) & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
If RecTemp.Fields("ConVertFlag") Then
Bln_ConVertFlag = True
Else
Bln_ConVertFlag = False
End If
If Bln_Foreign Then
'按原币核销
.Fields("YbCancelje") = .Fields("YbCancelje") + Val(CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)))
Dbl_CWbje = Val(CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)))
If Not Bln_ConVertFlag Then
.Fields("BbCancelje") = Format(.Fields("YbCancelje") * .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
Dbl_CBbje = Format(Dbl_CWbje * .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
Else
.Fields("BbCancelje") = Format(.Fields("YbCancelje") / .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
Dbl_CBbje = Format(Dbl_CWbje / .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
End If
If .Fields("YbCancelje") = .Fields("YbYsje") Then
.Fields("OverStatus") = 1
End If
Else
'按本币核销
.Fields("BbCancelje") = .Fields("BbCancelje") + Val(CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)))
Dbl_CBbje = Val(CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)))
If Bln_ConVertFlag Then
.Fields("YbCancelje") = Format(.Fields("BbCancelje") * .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
Dbl_CWbje = Format(Dbl_CBbje * .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
Else
.Fields("YbCancelje") = Format(.Fields("BbCancelje") / .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
Dbl_CWbje = Format(Dbl_CBbje / .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
End If
If .Fields("BbCancelje") = .Fields("BbYsje") Then
.Fields("OverStatus") = 1
End If
End If
.Update
If Rec_Cancel.State = 1 Then Rec_Cancel.Close
Rec_Cancel.Open "Select * From RP_Cancel Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
Rec_Cancel.AddNew
Rec_Cancel.Fields("AccListId") = .Fields("AccListId") '应收/应付明细帐ID
Rec_Cancel.Fields("RPFlag") = "AR" '应收/应付帐标识
If Int_Hxlx = 0 Then
Rec_Cancel.Fields("CancelItemCode") = "50" '核销处理过程编码(50:到款结算)
Else
Rec_Cancel.Fields("CancelItemCode") = "51" '核销处理过程编码(51:预收款冲应收款)
End If
Rec_Cancel.Fields("CusCode") = Str_CusCode '往来客户编码
Rec_Cancel.Fields("CancelNo") = Lng_CancelNo '核销过程序号
Rec_Cancel.Fields("CancelDate") = Xtrq '核销日期
Rec_Cancel.Fields("BillItemCode") = .Fields("BillItemCode") '单据类型编码
Rec_Cancel.Fields("BillID") = .Fields("BillID") '单据ID
Rec_Cancel.Fields("BillCode") = .Fields("BillCode") '单据编号
Rec_Cancel.Fields("ForeignCurrCode") = .Fields("ForeignCurrCode") '原币编码
Rec_Cancel.Fields("AccRate") = .Fields("AccRate") + 0 '记帐汇率
Rec_Cancel.Fields("YbCancelJe") = Dbl_CWbje '原币核销金额
Rec_Cancel.Fields("BbCancelJe") = Dbl_CBbje '本币核销金额
Rec_Cancel.Fields("Ybye") = .Fields("YbYsje") - .Fields("YbCancelje") '原币剩余金额
Rec_Cancel.Fields("Bbye") = .Fields("BbYsje") - .Fields("BbCancelje") '本币剩余金额
Rec_Cancel.Fields("Canceler") = Xtczy
Rec_Cancel.Update
'如果为销售发票,则填写回款金额
If Trim(.Fields("BillItemCode")) = "10" Or Trim(.Fields("BillItemCode")) = "11" Then
Sqlstr = "Update XS_InvoiceBillMain SET ComingValue=ComingValue+" & Dbl_CBbje & ",ComingValueFor=ComingValueFor+" & Dbl_CWbje & " Where InvoiceBillMainID=" & .Fields("BillId")
Cw_DataEnvi.DataConnect.Execute (Sqlstr)
End If
End With
End If
Next jsqte
End With
'1.核销到款明细帐
With CxbbGrid1
For jsqte = .FixedRows To .Rows - 1
If .TextMatrix(jsqte, Sydz("002", GridStr1(), Szzls1)) = True Then
With Rec_AccList
If Rec_AccList.State = 1 Then .Close
Sqlstr = "Select RP_Acclist.* From RP_AccList" & _
" Where AcclistID = " & Val(CxbbGrid1.TextMatrix(jsqte, 0))
Rec_AccList.Open Sqlstr, Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
Sqlstr = "Select Gy_ForeignCurrency.ConVertFlag From Gy_ForeignCurrency where Gy_ForeignCurrency.ForeignCurrCode='" & Trim(.Fields("ForeignCurrCode")) & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
If RecTemp.Fields("ConvertFlag") Then
Bln_ConVertFlag = True
Else
Bln_ConVertFlag = False
End If
If Bln_Foreign Then
'按原币核销
.Fields("YbCancelje") = .Fields("YbCancelje") + Val(CxbbGrid1.TextMatrix(jsqte, Sydz("008", GridStr1(), Szzls1)))
Dbl_CWbje = Val(CxbbGrid1.TextMatrix(jsqte, Sydz("008", GridStr1(), Szzls1)))
If Not Bln_ConVertFlag Then
.Fields("BbCancelje") = Format(.Fields("YbCancelje") * .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
Dbl_CBbje = Format(Dbl_CWbje * .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
Else
.Fields("BbCancelje") = Format(.Fields("YbCancelje") / .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
Dbl_CBbje = Format(Dbl_CWbje / .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
End If
If .Fields("YbCancelje") = .Fields("YbSsje") Then
.Fields("OverStatus") = 1
End If
Else
'按本币核销
.Fields("BbCancelje") = .Fields("BbCancelje") + Val(CxbbGrid1.TextMatrix(jsqte, Sydz("008", GridStr1(), Szzls1)))
Dbl_CBbje = Val(CxbbGrid1.TextMatrix(jsqte, Sydz("008", GridStr1(), Szzls1)))
If Bln_ConVertFlag Then
.Fields("YbCancelje") = Format(.Fields("BbCancelje") * .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
Dbl_CWbje = Format(Dbl_CBbje * .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
Else
.Fields("YbCancelje") = Format(.Fields("BbCancelje") / .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
Dbl_CWbje = Format(Dbl_CBbje / .Fields("AccRate"), "##." + String(Xtjexsws, "0"))
End If
If .Fields("BbCancelje") = .Fields("BbSsje") Then
.Fields("OverStatus") = 1
End If
End If
.Update
If Rec_Cancel.State = 1 Then Rec_Cancel.Close
Rec_Cancel.Open "Select * From RP_Cancel Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
Rec_Cancel.AddNew
Rec_Cancel.Fields("AccListId") = .Fields("AccListId") '应收/应付明细帐ID
Rec_Cancel.Fields("RPFlag") = "AR" '应收/应付帐标识
If Int_Hxlx = 0 Then
Rec_Cancel.Fields("CancelItemCode") = "50" '核销处理过程编码(50:到款结算)
Else
Rec_Cancel.Fields("CancelItemCode") = "51" '核销处理过程编码(51:预收款冲应收款)
End If
Rec_Cancel.Fields("CusCode") = Str_CusCode '往来客户编码
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -