|
2#
楼主 |
发表于 2023-9-30 12:38:55
|
只看该作者
各位大师帮帮忙!!怎么才能在加载发货单的同时,加载相对应的订单子表上的记录,
Private Sub Form_Load()
On Error GoTo ErrorHandler
Dim rst As Object
Dim rstTmp As Object
Dim strSQL As String
Dim currentID As String
CurrentDb.Execute "DELETE FROM TMP_发货_Detail"
If IsNull(Me.OpenArgs) Then
Me.DataEntry = True
End If
If Me.DataEntry Then
Exit Sub
End If
urrentID = Form_Frm_发货!Frm_发货_List_Child.Form.发货序号
strSQL = "select * from Tbl_发货 where 发货序号 ='" & currentID & "'"
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
rst.MoveFirst
Me.发货序号 = currentID
Me.明细主号 = "F" & Mid([currentID], 4, 6)
………………
Me.备注 = rst!备注
rst.Close
strSQL = "select * from Tbl_发货_Detail where 发货序号 ='" & Me.发货序号 & "'"
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
Set rstTmp = CurrentDb.OpenRecordset("TMP_发货_Detail")
Do Until rst.EOF
rstTmp.AddNew
rstTmp![发货序号] = rst![发货序号]
rstTmp![发货单号] = rst![发货单号]
rstTmp![订单明细] = rst![订单明细]
………………
rstTmp![金额] = rst![金额]
rstTmp![结算日期] = rst![结算日期]
rstTmp.Update
rst.MoveNext
Loop
rst.Close
rstTmp.Close
Me.Frm_发货_Edit_Detail_Child.Requery
ExitHere:
Set rst = Nothing
Set rstTmp = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbCritical
Resume ExitHere
End Sub
Private Sub Cmd保存_Click()
If Me.DataEntry Then
Call TJ
Me.Frm_发货_Edit_Detail_Child.Requery
Else
Call XG
DoCmd.Close acForm, Me.Name, acSaveNo
DoCmd.Restore
End If
End Sub
Public Sub TJ()
Dim rst As Object
Dim rstTmp As Object
Dim strSQL As String
Dim currentID As String
Dim currentID1 As String
currentID = AutoNumStr("Tbl_发货", "发货序号", 6, "No:", "") '用编号模块输入发货序号。
strSQL = "select * from Tbl_发货 "
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
rst.AddNew
rst!发货序号 = currentID
…………
rst![备注] = Me![备注]
rst.Update
rst.Close
strSQL = "select * from Tbl_发货_Detail WHERE [发货序号]='" & Me![发货序号] & "'"
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
Set rstTmp = CurrentDb.OpenRecordset("TMP_发货_Detail")
Do Until rstTmp.EOF
rst.AddNew
rst![发货序号] = currentID
rst![订单明细] = rstTmp![订单明细]
…………
rst![数量] = rstTmp![数量]
rst![单价] = rstTmp![单价]
rst![金额] = Round(rstTmp![数量] * rstTmp![单价], 2)
rst.Update
rstTmp.MoveNext
Loop
rst.Close
rstTmp.Close
'将输入框清空
Dim ctrl As Control
For Each ctrl In Me.Form.Controls
If (TypeOf ctrl Is TextBox And InStr(1, ctrl.Name, "合计") = 0) Or TypeOf ctrl Is ComboBox Then
ctrl = Null
End If
Next ctrl
CurrentDb.Execute "DELETE FROM TMP_发货_Detail"
Form_Frm_发货.Frm_发货_List_Child.Form.Requery
MsgBox "新增的记录保存成功!", vbInformation, "提示"
ExitHere:
Set rst = Nothing
Set rstTmp = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbCritical
Resume ExitHere
End Sub
Public Sub XG()
Dim rst As Object
Dim rstTmp As Object
Dim strSQL As String
Dim currentID As String
strSQL = "select * from Tbl_发货 where 发货序号 ='" & Me.发货序号 & "'"
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
rst.MoveFirst
rst.Edit
rst![审核] = Me.[审核]
…………
rst![备注] = Me![备注]
rst.Update
rst.Close
CurrentDb.Execute "Delete from Tbl_发货_Detail WHERE [发货序号]='" & Me![发货序号] & "'"
strSQL = "select * from Tbl_发货_Detail WHERE [发货序号]='" & Me![发货序号] & "'"
Set rst = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
Set rstTmp = CurrentDb.OpenRecordset("TMP_发货_Detail")
Do Until rstTmp.EOF
rst.AddNew
rst![发货序号] = Me![发货序号]
rst![订单明细] = rstTmp![订单明细]
………………
rst![数量] = rstTmp![数量]
rst![单价] = rstTmp![单价]
rst![金额] = Round(rstTmp![数量] * rstTmp![单价], 2)
rst.Update
rstTmp.MoveNext
Loop
rst.Close
rstTmp.Close
MsgBox "修改后的记录保存成功!", vbInformation, "提示"
ExitHere:
Set rst = Nothing
Set rstTmp = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbCritical
Resume ExitHere
End Sub |
|