⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄

📁 VB开发的ERP系统
💻
📖 第 1 页 / 共 5 页
字号:
                    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 + -