📄 -
字号:
Call Sub_OperStatus("10")
End If
Rec_Query.Requery
Rec_Query.find "ShipDeliverId=" & Val(Lab_BillId.Caption)
Exit Sub
Swcwcl: '单据删除时出现错误
Cw_DataEnvi.DataConnect.RollbackTrans
Tsxx = "单据删除过程中出现未知错误,程序自动恢复保存前状态!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End Sub
Private Sub Sub_AbandonBill() '放弃对当前单据的操作
Dim jsqte As Long '临时使用计数器
'先关闭录入载体(Fixed)
Changelock = True
Valilock = True
Changelock = False
Valilock = False
'如果单据有效则重新显示当前单据,置单据为空状态
If Not Rec_Query.EOF Then
Lab_BillId.Caption = Rec_Query.Fields("ShipDeliverId")
Call Sub_ShowBill
Else
'单据ID置为0
Lab_BillId.Caption = 0
'清除录入文本框
For jsqte = Max_Text_Index To 0 Step -1
LrText(jsqte).Tag = ""
LrText(jsqte).Text = ""
Next jsqte
End If
'设置操作状态为浏览
Lab_OperStatus = "1"
Call Sub_OperStatus("10")
End Sub
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 '录入有误列值
Sub_SaveBill = False
'一.============先对单据内容进行有效性判断==============='
'对需要进行事后判断的文本框录入内容进行有效性判断 (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
'先进行字段不能为空或不能为零有效性判断(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
If IsDate(LrText(17)) And LrText(17) > LrText(18) Then
Tsxx = "装箱日期不能大于开船日期!"
Call Xtxxts(Tsxx, 0, 1)
LrText(17).SetFocus
Exit Function
End If
If IsDate(LrText(19)) And LrText(18) > LrText(19) Then
Tsxx = "开船日期不能大于回单日期!"
Call Xtxxts(Tsxx, 0, 1)
LrText(18).SetFocus
Exit Function
End If
'二.=============如果以上有效性检查均顺利通过,则执行存盘动作============'
'对存盘进行事务处理(Fixed)
On Error GoTo Swcwcl
Cw_DataEnvi.DataConnect.BeginTrans
'判断单据状态以进行不同处理
'1.先对单据主表进行处理
If Trim(Lab_OperStatus) = "2" Then
'新增单据
'1.对于某些单据号自动生成的单据则可在此处自动生成
LrText(1).Text = CreatBillCode(BillCode, True)
'2.开始存盘
'打开单据主表动态集
If Rec_VouchMain.State = 1 Then Rec_VouchMain.Close
Rec_VouchMain.Open "Select * From Tr_ShipDeliver Where 1=2", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
With Rec_VouchMain
.AddNew
.Fields("ShipdeliverId") = CreatBillID(BillCode)
.Fields("ShipdeliverDate") = CDate(LrText(0).Text) '开票日期
.Fields("ShipDelivernum") = Trim(LrText(1).Text) '水运单号
.Fields("ldgnum") = Trim(LrText(2)) '销售发货单号
.Fields("sellcustcode") = Trim(LrText(3).Tag) '客户编码
.Fields("sellcustname") = Trim(LrText(3))
.Fields("address") = Trim(LrText(4)) '地址
.Fields("phone") = Trim(LrText(5)) '联系方式
.Fields("person") = Trim(LrText(6)) '联系人
.Fields("Mnumber") = Trim(LrText(7)) '货物编码
.Fields("goodsgroup") = Trim(LrText(10)) '批次
.Fields("quantity") = Trim(LrText(11)) '吨位
.Fields("price") = Trim(LrText(12)) '单价
.Fields("boxnum") = Val(LrText(13)) '箱量
.Fields("watcherman") = Trim(LrText(14)) '监装人
.Fields("sendman") = Trim(LrText(15)) '发货人
.Fields("receivecode") = Trim(LrText(16).Tag) '承运单位
If IsDate(Trim(LrText(17))) Then '装箱日期
.Fields("upboxdate") = Trim(LrText(17))
Else
.Fields("upboxdate") = Null
End If
.Fields("startdate") = Trim(LrText(18)) '开船日期
If IsDate(LrText(19)) Then '回单日期
.Fields("returndate") = Trim(LrText(19))
Else
.Fields("returndate") = Null
End If
.Fields("shipway") = Trim(LrText(20)) '船名船号
.Fields("carrynum") = Trim(LrText(21)) '运单号
.Fields("remark") = Trim(LrText(22)) '备注
.Fields("maker") = Xtczy '制单人
.Fields("Checker") = "" '审核人置空
.Update
'系统读出单据ID写入Lab_BillID
Lab_BillId.Caption = .Fields("ShipDeliverId")
End With
Else
'修改单据
'打开单据主表动态集
If Rec_VouchMain.State = 1 Then Rec_VouchMain.Close
Rec_VouchMain.Open "Select * From Tr_ShipDeliver Where ShipDeliverId=" & Val(Lab_BillId.Caption), Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
With Rec_VouchMain
.Fields("ShipdeliverDate") = CDate(LrText(0).Text) '开票日期
.Fields("ShipDelivernum") = Trim(LrText(1).Text) '水运单号
.Fields("ldgnum") = Trim(LrText(2)) '销售发货单号
.Fields("sellcustcode") = Trim(LrText(3).Tag) '客户编码
.Fields("sellcustname") = Trim(LrText(3))
.Fields("address") = Trim(LrText(4)) '地址
.Fields("phone") = Trim(LrText(5)) '联系方式
.Fields("person") = Trim(LrText(6)) '联系人
.Fields("Mnumber") = Trim(LrText(7)) '货物编码
.Fields("goodsgroup") = Trim(LrText(10)) '批次
.Fields("quantity") = Trim(LrText(11)) '吨位
.Fields("price") = Trim(LrText(12)) '单价
.Fields("boxnum") = Val(LrText(13)) '箱量
.Fields("watcherman") = Trim(LrText(14)) '监装人
.Fields("sendman") = Trim(LrText(15)) '发货人
.Fields("receivecode") = Trim(LrText(16).Tag) '承运单位
If IsDate(Trim(LrText(17))) Then '装箱日期
.Fields("upboxdate") = Trim(LrText(17))
Else
.Fields("upboxdate") = Null
End If
.Fields("startdate") = Trim(LrText(18)) '开船日期
If IsDate(LrText(19)) Then '回单日期
.Fields("returndate") = Trim(LrText(19))
Else
.Fields("returndate") = Null
End If
.Fields("shipway") = Trim(LrText(20)) '船名船号
.Fields("carrynum") = Trim(LrText(21)) '运单号
.Fields("remark") = Trim(LrText(22)) '备注
.Fields("maker") = Xtczy '制单人
.Fields("Checker") = "" '审核人置空
.Update
End With
End If
Cw_DataEnvi.DataConnect.CommitTrans
Sub_SaveBill = True
Tsxx = "单据存盘完毕! 单据号:" & Trim(LrText(1).Text)
Call Xtxxts(Tsxx, 0, 4)
'标识单据发生改动
Bln_BillChange = True
'设置单据改变后的状态
Lab_OperStatus = "1"
Call Sub_OperStatus("10")
Rec_Query.Requery
Rec_Query.find "ShipDeliverId=" & Val(Lab_BillId.Caption)
Exit Function
Swcwcl: '数据存盘时出现错误
Cw_DataEnvi.DataConnect.RollbackTrans
If Err.Number = -2147217887 Then
Tsxx = "录入数据超出允许范围!"
Call Xtxxts(Tsxx, 0, 1)
Exit Function
Else
Tsxx = "存盘过程中出现未知错误,程序自动恢复保存前状态!"
Call Xtxxts(Tsxx, 0, 1)
Exit Function
End If
End Function
'选择首张,上张,下张,末张(此4个过程只需用您的单据ID字段名替换"ArriveMainId"即可)
Private Sub Sub_First() '首 张
With Rec_Query
If .RecordCount = 0 Then
Exit Sub
End If
.MoveFirst
Lab_BillId.Caption = .Fields("ShipDeliverId")
Call Sub_ShowBill
End With
End Sub
Private Sub Sub_Prev() '上 张
With Rec_Query
If .RecordCount = 0 Then
Exit Sub
End If
.MovePrevious
If Not .BOF Then
Lab_BillId.Caption = .Fields("ShipDeliverId")
Else
.MoveNext
End If
Call Sub_ShowBill
End With
End Sub
Private Sub Sub_Next() '下 张
With Rec_Query
If .RecordCount = 0 Then
Exit Sub
End If
.MoveNext
If Not .EOF Then
Lab_BillId.Caption = .Fields("ShipDeliverId")
Else
.MovePrevious
End If
Call Sub_ShowBill
End With
End Sub
Private Sub Sub_Last() '末 张
With Rec_Query
If .RecordCount = 0 Then
Exit Sub
End If
.MoveLast
Lab_BillId.Caption = .Fields("ShipDeliverId")
Call Sub_ShowBill
End With
End Sub
'[>>===================以下为根据实际业务需要自定义过程区域=============================<<]
'审核,弃审
Private Sub Sub_CheckBill() '审 核
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(Str_RightCheck, Xtczybm, 1, True) Then
Exit Sub
End If
'[>>
'此处可以写入禁止单据审核的理由
'<<]
'将单据写入审核标识
Cw_DataEnvi.DataConnect.Execute ("Update Tr_ShipDeliver Set Checker='" & Xtczy & "' Where ShipDeliverId=" & Val(Lab_BillId.Caption))
'写入系统操作员
LrText(24).Text = Xtczy
'设置审核弃审按钮状态
Call Sub_CheckStatus
Tsxx = "审核完毕!"
Call Xtxxts(Tsxx, 0, 4)
'标识单据发生变化
Bln_BillChange = True
End Sub
Private Sub Sub_AbandonCheck() '弃 审
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -