📄
字号:
JiTextptpd = False
Exit Function
End If
End If
For i = LBound(arrVar_TableCon2, 1) To UBound(arrVar_TableCon2, 1)
If JiText(0).Text >= arrVar_TableCon2(i, 1) And JiText(0).Text <= arrVar_TableCon2(i, 2) Then
Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态,请重新输入时间!"
Call Xtxxts(Tsxx, 0, 1)
JiText(0).SetFocus
JiTextptpd = False
Exit Function
End If
If JiText(1).Text >= arrVar_TableCon2(i, 1) And JiText(1).Text <= arrVar_TableCon2(i, 2) Then
Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态,请重新输入时间!"
Call Xtxxts(Tsxx, 0, 1)
JiText(1).SetFocus
JiTextptpd = False
Exit Function
End If
If JiText(0) <= arrVar_TableCon2(i, 1) And JiText(1).Text >= arrVar_TableCon2(i, 2) Then
Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态,请重新输入时间!"
Call Xtxxts(Tsxx, 0, 1)
JiText(1).SetFocus
JiTextptpd = False
Exit Function
End If
Next i
End If
Else '修改
'先查询出同车号各状态正在进行的记录并找出最大时间与填入记录进行判断
str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=0 order by BeginTime "
Set rs_Tmp = Nothing
Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
If Not rs_Tmp.RecordCount = 0 Then
ReDim arrVar_TableCon(rs_Tmp.RecordCount - 1, 3)
End If
k = 0
Do While Not rs_Tmp.EOF()
arrVar_TableCon(k, 0) = Trim(rs_Tmp.Fields("NowStatus"))
arrVar_TableCon(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm")
arrVar_TableCon(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm")
arrVar_TableCon(k, 3) = rs_Tmp.Fields("VoucherId")
rs_Tmp.MoveNext
k = k + 1
Loop
If Not rs_Tmp.RecordCount = 0 Then
For i = LBound(arrVar_TableCon, 1) To UBound(arrVar_TableCon, 1)
If i = UBound(arrVar_TableCon, 1) Then
If JiText(0).Text >= arrVar_TableCon(i, 1) And arrVar_TableCon(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态,请重新输入时间!"
Call Xtxxts(Tsxx, 0, 1)
JiText(0).SetFocus
JiTextptpd = False
Exit Function
End If
If JiText(1).Text <> "____-__-__ __:__" Then
If JiText(1).Text >= arrVar_TableCon(i, 1) And arrVar_TableCon(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
Tsxx = "此车号正处于" & arrVar_TableCon(i, 0) & "状态,请重新输入时间!"
Call Xtxxts(Tsxx, 0, 1)
JiText(1).SetFocus
JiTextptpd = False
Exit Function
End If
End If
End If
Next i
str_tmp = "select * from Tr_Move where MoveId='" & dbl_RecordAutoCode & "'and result=0 order by MoveEndTime "
Set Findrec = Nothing
Set Findrec = Cw_DataEnvi.DataConnect.Execute(str_tmp)
If Findrec.RecordCount = 0 Then
If JiText(1).Text = "____-__-__ __:__" Then
Tsxx = "调车完毕时间不能为空"
Call Xtxxts(Tsxx, 0, 1)
JiText(1).SetFocus
JiTextptpd = False
Exit Function
End If
End If
End If
'先查询出同车号各状态已完成的记录并找出最大时间与填入记录进行判断
str_tmp = "select * from Tr_NowAccount where VehicleNum='" & Trim(LrText(0).Text) & "'and LimitMark=1 order by BeginTime "
Set rs_Tmp = Nothing
Set rs_Tmp = Cw_DataEnvi.DataConnect.Execute(str_tmp)
If Not rs_Tmp.RecordCount = 0 Then
ReDim arrVar_TableCon2(rs_Tmp.RecordCount - 1, 3)
End If
k = 0
Do While Not rs_Tmp.EOF()
arrVar_TableCon2(k, 0) = Trim(rs_Tmp.Fields("NowStatus"))
arrVar_TableCon2(k, 1) = Format(Trim(rs_Tmp.Fields("BeginTime")), "yyyy-mm-dd hh:mm")
arrVar_TableCon2(k, 2) = Format(Trim(rs_Tmp.Fields("EndTime")), "yyyy-mm-dd hh:mm")
arrVar_TableCon2(k, 3) = rs_Tmp.Fields("VoucherId")
rs_Tmp.MoveNext
k = k + 1
Loop
str_tmp = "select * from Tr_Move where MoveId='" & dbl_RecordAutoCode & "'and result=1 order by MoveEndTime "
Set Findrec = Nothing
Set Findrec = Cw_DataEnvi.DataConnect.Execute(str_tmp)
If Not Findrec.RecordCount = 0 Then
If CDate(Findrec.Fields("MoveEndTime")) = arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 2) Then
If JiText(1).Text = "____-__-__ __:__" Then
If JiText(0).Text = arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 1) Then
JiTextptpd = True
Exit Function
End If
End If
End If
End If
If Not rs_Tmp.RecordCount = 0 Then
If JiText(0).Text < arrVar_TableCon2(UBound(arrVar_TableCon2, 1), 2) Then
If Trim(JiText(1).Text) = "____-__-__ __:__" Then
Tsxx = "调车完毕时间不能为空"
Call Xtxxts(Tsxx, 0, 1)
JiText(1).SetFocus
JiTextptpd = False
Exit Function
End If
End If
For i = LBound(arrVar_TableCon2, 1) To UBound(arrVar_TableCon2, 1)
If JiText(0) >= arrVar_TableCon2(i, 1) And JiText(0).Text <= arrVar_TableCon2(i, 2) And arrVar_TableCon2(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态,请重新输入时间!"
Call Xtxxts(Tsxx, 0, 1)
JiText(0).SetFocus
JiTextptpd = False
Exit Function
End If
If JiText(1) >= arrVar_TableCon2(i, 1) And JiText(1).Text <= arrVar_TableCon2(i, 2) And arrVar_TableCon2(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态,请重新输入时间!"
Call Xtxxts(Tsxx, 0, 1)
JiText(1).SetFocus
JiTextptpd = False
Exit Function
End If
If JiText(0) <= arrVar_TableCon2(i, 1) And JiText(1).Text >= arrVar_TableCon2(i, 2) And arrVar_TableCon2(i, 3) <> CzxsGrid.TextMatrix(CzxsGrid.Row, 1) Then
Tsxx = "此车号在" & arrVar_TableCon2(i, 1) & "至" & arrVar_TableCon2(i, 2) & ",处于" & arrVar_TableCon2(i, 0) & "状态,请重新输入时间!"
Call Xtxxts(Tsxx, 0, 1)
JiText(1).SetFocus
JiTextptpd = False
Exit Function
End If
Next i
End If
End If
JiTextptpd = True
Exit Function
Pdbz:
Tsxx = "出现未知错误!"
Call Xtxxts(Tsxx, 0, 1)
JiTextptpd = False
Exit Function
End Function
'*******************以上区域为编写自定义过程区域**********************
'******************以下为基本处理程序(固定不变)************************'
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) '支持热键操作
If Shift = 2 Then
Select Case UCase(Chr(KeyCode))
Case "P" 'Ctrl+P 打印
If SzToolbar.Buttons("dy").Visible And SzToolbar.Buttons("dy").Enabled Then
Call bbyl(False)
End If
Case "A" 'Ctrl+A 增加
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
Exit Sub
End If
If SzToolbar.Buttons("zj").Visible And SzToolbar.Buttons("zj").Enabled Then
Call Toolbjzt
Lrzt = 1
Call Cshlrxx(Lrzt)
LrText(0).Enabled = True
LrText(0).SetFocus
End If
Case "D" 'Ctrl+D 删除
If SzToolbar.Buttons("sc").Visible And SzToolbar.Buttons("sc").Enabled Then
Call Scdqjl
End If
End Select
End If
End Sub
Private Sub LrText_Validate(Index As Integer, Cancel As Boolean)
Dim Str_temp As String
Dim Rs_temp As New ADODB.Recordset
Select Case Index
Case 0
If Trim(LrText(Index).Text) <> "" Then
Str_temp = "select a.parkcode as parkcode,b.parkname as parkname from tr_move A left outer join tr_park B on A.parkcode=B.parkcode where a.vehiclenum='" & Trim(LrText(Index).Text & "") & "'and a.movetime in (select max(movetime) from tr_move where vehiclenum='" & Trim(LrText(0).Text) & "') order by A.vehiclenum,a.movetime"
Set Rs_temp = Nothing
Set Rs_temp = Cw_DataEnvi.DataConnect.Execute(Str_temp)
If Not Rs_temp.RecordCount = 0 Then
LrText(1).Text = Trim(Rs_temp.Fields("parkname") & "")
End If
Else
LrText(1).Text = ""
End If
End Select
End Sub
Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "ymsz" '页面设置
Dyymctbl.Show 1
Case "yl" '预 览
Call bbyl(True)
Case "dy" '打 印
Call bbyl(False)
Case "zj" '增 加
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
Exit Sub
End If
Call Toolbjzt
Lrzt = 1
Call Cshlrxx(Lrzt)
LrText(0).Enabled = True
LrText(0).SetFocus
Ydcommand1(0).Enabled = True
LrText(1).Enabled = False
Case "xg" '修 改
Call Xgdqjl
Case "sc" '删 除
Call Scdqjl
Case "sx" '刷 新
Call Cxnrtcwg
Case "bz" '帮 助
Call F1bz
Case "fh" '退 出
Unload Me
End Select
End Sub
Private Sub CzxsGrid_DblClick() '修改当前编码记录
Call Xgdqjl
End Sub
Private Sub Xgdqjl() '修改当前编码记录
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(Str_RightEdit, Xtczybm, 1, True, False) Then
BcCommand.Enabled = False
End If
If CzxsGrid.Row < CzxsGrid.FixedRows Then
Exit Sub
End If
Call Toolbjzt
Lrzt = 2
If Cshlrxx(Lrzt) Then
LrText(2).SetFocus
LrText(0).Enabled = False
LrText(1).Enabled = False
Ydcommand1(0).Enabled = False
End If
End Sub
Private Sub Toolbjzt() 'Toolbar状态(编辑状态)
StTab.TabEnabled(1) = True
StTab.Tab = 1
Frame1.Enabled = True
StTab.TabEnabled(0) = False
CzxsGrid.Enabled = False
With SzToolbar
.Buttons("ymsz").Enabled = False
.Buttons("dy").Enabled = False
.Buttons("yl").Enabled = False
.Buttons("zj").Enabled = False
.Buttons("xg").Enabled = False
.Buttons("sc").Enabled = False
.Buttons("sx").Enabled = False
End With
End Sub
Private Sub Toolfbjzt() 'Toolbar状态(非编辑状态)
StTab.TabEnabled(0) = True
StTab.Tab = 0
CzxsGrid.Enabled = True
Frame1.Enabled
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -