|
Private Sub 提交_Click()
On Error GoTo Err_提交_Click
Dim I, j As Integer
Dim StrTemp As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Dim Rs1 As ADODB.Recordset
Set Rs1 = New ADODB.Recordset
Dim Rs2 As ADODB.Recordset
Set Rs2 = New ADODB.Recordset
StrTemp = "Select * From RS财务收款明细周转"
rs.Open StrTemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
StrTemp = "Select * From RS财务收款明细表"
Rs1.Open StrTemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
StrTemp = "Select * From RS财务收款统计"
Rs2.Open StrTemp, CurrentProject.Connection, adOpenKeyset, adLockOptimistic
'如果“销售表”为空,则退出
If rs.RecordCount <= 0 Then
Exit Sub
End If
rs.MoveFirst
For I = 0 To rs.RecordCount - 1
CunZai = False
If Rs2.RecordCount < 1 Then
CunZai = False
Else
'判断记录财务收款统计是否存在,是则更新财务收款统计信息
Rs2.MoveFirst
For j = 0 To Rs2.RecordCount - 1
If Rs2("编号") = rs("编号") And Rs2("KF") = rs("KF") And Rs2("FKFS") = rs("FKFS") And Rs2("DDHM") = rs("DDHM") And Rs2("PF") = rs("PF") And Rs2("BB") = rs("BB") And Rs2("HJJE") = rs("HJJE") Then
Rs2("YSK") = Rs2("YSK") + rs("YSK")
Rs2("SYJE") = rs("HJJE") - Rs2("YSK")
Rs2.Update
CunZai = True
Exit For
Else
Rs2.MoveNext
End If
Next j
End If
'不存在则添加新记录
If CunZai = False Then
Rs2.AddNew
Rs2("编号") = rs("编号")
Rs2("KF") = rs("KF")
Rs2("FKFS") = rs("FKFS")
Rs2("SZRQ") = rs("SZRQ")
Rs2("SZBH") = rs("SZBH")
Rs2("DDHM") = rs("DDHM")
Rs2("PF") = rs("PF")
Rs2("BB") = rs("BB")
Rs2("HJJE") = rs("HJJE")
Rs2("YKFPJE") = rs("YKFPJE")
Rs2("BL1") = rs("BL1")
Rs2("FPHM") = rs("FPHM")
Rs2("WKFPJE") = rs("WKFPJE")
Rs2("BL2") = rs("BL2")
Rs2("YSK") = rs("YSK")
Rs2("SKRQ") = rs("SKRQ")
If Nz([YSK]) = "" Or Nz([SKRQ]) = "" Then
MsgBox "已收款\收款日期不能为空!", 64, "阿飞工作室提醒你"
End If
Rs2.Update
End If
'保存财务收款到RS财务收款明细表中
Rs1.AddNew
Rs1("编号") = rs("编号")
Rs1("KF") = rs("KF")
Rs1("FKFS") = rs("FKFS")
Rs1("SZRQ") = rs("SZRQ")
Rs1("SZBH") = rs("SZBH")
Rs1("DDHM") = rs("DDHM")
Rs1("PF") = rs("PF")
Rs1("BB") = rs("BB")
Rs1("HJJE") = rs("HJJE")
Rs1("YKFPJE") = rs("YKFPJE")
Rs1("BL1") = rs("BL1")
Rs1("FPHM") = rs("FPHM")
Rs1("WKFPJE") = rs("WKFPJE")
Rs1("BL2") = rs("BL2")
Rs1("YSK") = rs("YSK")
Rs1("SKRQ") = rs("SKRQ")
Rs1("SKR") = rs("SKR")
Rs1("SKBM") = rs("SKBM")
Rs1.Update
rs.Delete 1
'Me![RS财务收款登记子窗体].Requery
rs.MoveNext
Next I
Set rs = Nothing
Set Rs1 = Nothing
Set Rs2 = Nothing
Me![RS财务收款登记表子窗体].Requery
MsgBox "财务收款已经提交成功", vbInformation, "阿飞工作室提醒你"
Exit_提交_Click:
Set rs = Nothing
Set Rs1 = Nothing
Set Rs2 = Nothing
Exit Sub
Err_提交_Click:
MsgBox Err.Description
Resume Exit_提交_Click
End Sub |
本帖子中包含更多资源
您需要 登录 才可以下载或查看,没有帐号?注册
x
|