📄
字号:
End Sub
Private Sub Jltcwg(Jlbrec As ADODB.Recordset, Rowjsq As Long) '记录内容填充网格
'[>>以下为自定义部分
With Jlbrec
CzxsGrid.TextMatrix(Rowjsq, 0) = .Fields("CheckId")
CzxsGrid.TextMatrix(Rowjsq, 1) = .Fields("VoucherId")
CzxsGrid.TextMatrix(Rowjsq, Sydz("001", GridStr(), szzls)) = Trim(.Fields("VehicleNum") & "") '车号
If Not IsNull(.Fields("CheckTime")) Then
CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), szzls)) = Format(Trim(.Fields("CheckTime")), "yyyy-mm-dd hh:mm") '要求查车时间
Else
CzxsGrid.TextMatrix(Rowjsq, Sydz("002", GridStr(), szzls)) = ""
End If
If Not IsNull(.Fields("CheckEndTime")) Then
CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), szzls)) = Format(Trim(.Fields("CheckEndTime")), "yyyy-mm-dd hh:mm") '查车完毕时间
Else
CzxsGrid.TextMatrix(Rowjsq, Sydz("003", GridStr(), szzls)) = ""
End If
If Not IsNull(.Fields("CheckMan")) Then
CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), szzls)) = Trim(.Fields("CheckMan") & "") '查车负责人
Else
CzxsGrid.TextMatrix(Rowjsq, Sydz("004", GridStr(), szzls)) = ""
End If
If Trim(.Fields("Result")) = True Then '查车状态
CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), szzls)) = "已查车"
Else
CzxsGrid.TextMatrix(Rowjsq, Sydz("005", GridStr(), szzls)) = "未查车"
End If
End With
'以上为自定义部分<<]
End Sub
Private Sub Form_Unload(Cancel As Integer) '窗体卸载
dbl_RecordAutoCode = 0
Set Cxnrrec = Nothing
Set Rec_CodeSet = Nothing
Unload Dyymctbl
End Sub
Private Function Bclrsj() As Boolean '判断录入数据有效性,并保存数据
Dim jsqte As Integer
Dim Findrc As New ADODB.Recordset
'对文本框录入内容进行为零和为空判断(固定不变)
With Rec_CodeSet
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
Bclrsj = False
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
Bclrsj = False
Exit Function
End If
End If
End If
Next jsqte
'<<自定义
'判断要求查车时间的年度是否与当前会计年度相符
If Trim(JiText(0).Text <> "____-__-__ __:__") Then
If IsDate(JiText(0).Text) Then
JiText(0).Text = Format(JiText(0).Text, "yyyy-mm-dd hh:mm")
If Val(Trim(JiText(0).Text)) <> Val(Year(Xtrq)) Then
Tsxx = "年度与当前会计年度不符，请重新输入"
Call Xtxxts(Tsxx, 0, 4)
JiText(0).SetFocus
Exit Function
End If
Else
Tsxx = "非法公历时间!(格式:" + Format(Date, "yyyy-mm-dd hh:mm") + ")"
Call Xtxxts(Tsxx, 0, 1)
JiText(0).SetFocus
Exit Function
End If
End If
'要求查车时间不能为空
If Trim(JiText(0).Text) = "____-__-__ __:__" Then
Tsxx = "要求查车时间不能为空!"
Call Xtxxts(Tsxx, 0, 1)
JiText(0).SetFocus
Bclrsj = False
Exit Function
End If
'判断查车完毕时间的年度是否与当前会计年度相符
If Trim(JiText(1).Text <> "____-__-__ __:__") Then
If IsDate(JiText(1).Text) Then
JiText(1).Text = Format(JiText(1).Text, "yyyy-mm-dd hh:mm")
If Val(Trim(JiText(1).Text)) <> Val(Year(Xtrq)) Then
Tsxx = "年度与当前会计年度不符，请重新输入"
Call Xtxxts(Tsxx, 0, 4)
JiText(1).SetFocus
Exit Function
End If
Else
Tsxx = "非法公历时间!(格式:" + Format(Date, "yyyy-mm-dd hh:mm") + ")"
Call Xtxxts(Tsxx, 0, 1)
JiText(1).SetFocus
Exit Function
End If
End If
'要求查车时间不能大于查车完毕时间
If Trim(JiText(0).Text) <> "____-__-__ __:__" And Trim(JiText(1).Text) <> "____-__-__ __:__" Then
If CDate(JiText(0).Text) > CDate(JiText(1).Text) Then
Tsxx = "要求查车时间不能大于查车完毕时间!"
Call Xtxxts(Tsxx, 0, 1)
Bclrsj = False
JiText(1).SetFocus
Exit Function
End If
End If
If Not JiTextptpd Then
Exit Function
End If
'>>
'对需要进行事后判断的文本框录入内容进行有效性判断 (固定不变)
For jsqte = 0 To Max_Text_Index
If Textint(jsqte, 9) = 0 Or Textint(jsqte, 9) = 2 Then
If Not TextYxxpd(jsqte) Then
Exit Function
End If
End If
Next jsqte
If Lrzt = 1 Then '增 加
If .State = 1 Then .Close
.Open "SELECT * FROM Tr_Check where 1=2 ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
'判断记录内容无误后,将记录内容写入数据表
On Error GoTo Swcwcl
Cw_DataEnvi.DataConnect.BeginTrans
.AddNew
.Fields("VehicleNum") = Trim(LrText(0).Text & "") '车号
If Trim(JiText(0).Text) <> "____-__-__ __:__" Then
.Fields("CheckTime") = Format(JiText(0).Text, "yyyy-mm-dd hh:mm") '要求查车时间
Else
.Fields("CheckTime") = Null
End If
If Trim(JiText(1).Text) <> "____-__-__ __:__" Then
.Fields("CheckEndTime") = Format(JiText(1).Text, "yyyy-mm-dd hh:mm") '查车完毕时间
Else
.Fields("CheckEndTime") = Null
End If
If Trim(LrText(1).Text) <> "" Then
.Fields("CheckMan") = Trim(LrText(1).Text & "") '查车负责人
Else
.Fields("CheckMan") = ""
End If
If Trim(JiText(1).Text) <> "____-__-__ __:__" Then '查车状态
.Fields("Result") = 1
Else
.Fields("Result") = 0
End If
.Update
dbl_RecordAutoCode = .Fields("CheckId")
'增加记录的同时增加台准帐排它表中的记录(由此判断各状态时间问题)
If Findrc.State = 1 Then Findrc.Close
Findrc.Open "SELECT * FROM Tr_NowAccount where 1=2 ", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
Findrc.AddNew
Findrc.Fields("VoucherNum") = 3 '各状态拾别号查车为3
Findrc.Fields("ChildId") = dbl_RecordAutoCode
Findrc.Fields("VehicleNum") = Trim(.Fields("VehicleNum") & "") '车号
If Not IsNull(.Fields("CheckTime")) Then
Findrc.Fields("BeginTime") = Format(Trim(.Fields("CheckTime")), "yyyy-mm-dd hh:mm") '各状态要求时间
Else
Findrc.Fields("BeginTime") = Format(Trim(.Fields("CheckTime")), "yyyy-mm-dd hh:mm")
End If
If Not IsNull(.Fields("CheckEndTime")) Then
Findrc.Fields("EndTime") = Format(Trim(.Fields("CheckEndTime")), "yyyy-mm-dd hh:mm") '各状态完毕时间
Else
Findrc.Fields("EndTime") = Format(Trim(.Fields("CheckTime")), "yyyy-mm-dd hh:mm")
End If
Findrc.Fields("MNumber") = Null
If .Fields("Result") = True Then
Findrc.Fields("NowStatus") = "已查车" '目前状态
Findrc.Fields("LimitMark") = 1
Else
Findrc.Fields("NowStatus") = "查车"
Findrc.Fields("LimitMark") = 0
End If
Findrc.Update
Cw_DataEnvi.DataConnect.CommitTrans
'将记录加入网格
Sqlstr = "SELECT Tr_Check.*,Tr_NowAccount.VoucherId as VoucherId FROM Tr_Check left outer join Tr_NowAccount on Tr_Check.CheckId=Tr_NowAccount.ChildId where Tr_NowAccount.VoucherNum=3 and Tr_Check.CheckId='" & dbl_RecordAutoCode & "' order by Tr_Check.CheckTime"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With CzxsGrid
.AddItem ""
.RowHeight(.Rows - 1) = Sjhgd
.Select .Rows - 1, Qslz
Call Jltcwg(Cxnrrec, .Rows - 1)
End With
Tsxx = "保存完毕!"
Call Xtxxts(Tsxx, 0, 4)
Call Cshlrxx(1)
LrText(0).SetFocus
'将网格按编码排序
With CzxsGrid
.Col = Sydz("002", GridStr(), szzls)
CzxsGrid.Sort = flexSortStringAscending
End With
'<<]
Else '否则为修改记录
On Error GoTo Swcwcl
Cw_DataEnvi.DataConnect.BeginTrans
If .State = 1 Then .Close
.Open "SELECT * FROM Tr_Check WHERE CheckId= '" & dbl_RecordAutoCode & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not .EOF Then
If Trim(JiText(0).Text) <> "____-__-__ __:__" Then
.Fields("CheckTime") = Format(JiText(0).Text, "yyyy-mm-dd hh:mm") '要求查车时间
Else
.Fields("CheckTime") = Null
End If
If Trim(JiText(1).Text) <> "____-__-__ __:__" Then
.Fields("CheckEndTime") = Format(JiText(1).Text, "yyyy-mm-dd hh:mm") '查车完毕时间
Else
.Fields("CheckEndTime") = Null
End If
If Trim(LrText(1).Text) <> "" Then
.Fields("CheckMan") = Trim(LrText(1).Text & "") '查车负责人
Else
.Fields("CheckMan") = ""
End If
If Trim(JiText(1).Text) <> "____-__-__ __:__" Then '查车状态
.Fields("Result") = 1
Else
.Fields("Result") = 0
End If
.Update
End If
If Findrc.State = 1 Then Findrc.Close
Findrc.Open "SELECT * FROM Tr_NowAccount where ChildId = '" & dbl_RecordAutoCode & "'and VoucherNum=3", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic
If Not Findrc.EOF Then
If Not IsNull(.Fields("CheckTime")) Then
Findrc.Fields("BeginTime") = Format(Trim(.Fields("CheckTime")), "yyyy-mm-dd hh:mm") '各状态要求时间
Else
Findrc.Fields("BeginTime") = Format(Trim(.Fields("CheckTime")), "yyyy-mm-dd hh:mm")
End If
If Not IsNull(.Fields("CheckEndTime")) Then
Findrc.Fields("EndTime") = Format(Trim(.Fields("CheckEndTime")), "yyyy-mm-dd hh:mm") '各状态完毕时间
Else
Findrc.Fields("EndTime") = Format(Trim(.Fields("CheckTime")), "yyyy-mm-dd hh:mm")
End If
Findrc.Fields("MNumber") = Null
If .Fields("Result") = True Then
Findrc.Fields("NowStatus") = "已查车" '目前状态
Findrc.Fields("LimitMark") = 1
Else
Findrc.Fields("NowStatus") = "查车"
Findrc.Fields("LimitMark") = 0
End If
Findrc.Update
End If
Cw_DataEnvi.DataConnect.CommitTrans
'刷新当前网格
Sqlstr = "SELECT Tr_Check.*,Tr_NowAccount.VoucherId as VoucherId FROM Tr_Check left outer join Tr_NowAccount on Tr_Check.CheckId=Tr_NowAccount.ChildId where Tr_NowAccount.VoucherNum=3 and Tr_Check.CheckId='" & dbl_RecordAutoCode & "' order by Tr_Check.CheckTime"
Set Cxnrrec = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With CzxsGrid
Call Jltcwg(Cxnrrec, .Row)
End With
End If
'保存记录成功,函数返回真值
Bclrsj = True
Exit Function
End With
Swcwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
Tsxx = "存盘过程中出现错误,程序自动恢复保存前状态!"
Call Xtxxts(Tsxx, 0, 1)
Exit Function
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -