专家坐堂-系统中断操作Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

Try

Dim CellN As String = e.Form.Controls("CBox_Cell").Value

Dim Filter As String

If DataTables.Contains("ResourceID") = False Then

DataTables("ResourceID").Loadfilter = ""

DataTables("ResourceID").Load

End If

With e.Form.Controls("CBox_Res") \'存在资源号

If .Value IsNot Nothing Then

Filter = Filter & "ResID = \'" & .Value.ToUpper.trim & "\'" \'指定资源号

Else \' 不存在资源号

With e.Form.Controls("CBox_ResCat")

If .value IsNot Nothing AndAlso .value <> "All" Then \'存在资源类别

Dim ResCat As String = .Value

If Filter > "" Then

Filter = Filter & " And "

End If

Dim Res As String

For Each dr As DataRow In DataTables("ResourceID").DataRows

If dr("Catalog_中文") = ResCat Then

If Res = "" Then

Res = "\'" & dr("ResID") & "\'"

Else

Res = Res & ",\'" & dr("ResID") & "\'"

End If

Res = "(" & Res & ")"

Filter = Filter & "ResID in " & Res \'资源类别

\'\'MessageBox.Show("Click1")

Else \'不存在资源类别

If CellN <> "" AndAlso CellN <> "(All)" Then \'存在班组名

If Filter > "" Then

Filter = Filter & " And "

End If

Dim Res As String

For Each dr As DataRow In DataTables("ResourceID").DataRows

If dr("适用于标准化后的班组名称") = CellN Then

Res = Res & ",\'" & dr("ResID") & "\'" \'班组

End If

If Res > "" Then

Res = Res.Trim(",")

Res = "(" & Res & ")"

Filter = Filter & "ResID in " & Res

End If

End With

End If

End With

\'MessageBox.Show("1aFilter=" & Filter)

Dim WO As String

With e.Form.Controls("TBox_WO")

If .Value IsNot Nothing Then

WO = .Value.toupper.trim

If WO <> "" AndAlso Wo.Length > 0 Then

If Filter IsNot Nothing Then

Filter = Filter & " And "

End If

Filter = Filter & "[WO] like \'%" & WO & "%\'" \'[型号] Like \'A[*]%\'

End If

End With

With e.Form.Controls("TBox_PN")

If .Value IsNot Nothing Then

Dim PN As String = .Value.Toupper.trim

If PN <> "" AndAlso PN.Length > 0 Then

If Filter > "" Then

Filter = Filter & " And "

End If

Filter = Filter & "[PartNumber] like \'%" & PN & "%\'"

End If

End With

\'MessageBox.Show("1bFilter=" & Filter)

With e.Form.Controls("StartDate_OP")

If .Value IsNot Nothing Then

If Filter > "" Then

Filter = Filter & " And "

End If

Filter = Filter & "(Adj_StartTime >= #" & .Value & "# or Adj_StartTime is null )"

End If

End With

With e.Form.Controls("EndDate_OP")

If .Value IsNot Nothing Then

If Filter > "" Then

Filter = Filter & " And "

End If

Filter = Filter & "(Adj_EndTime < #" & .Value.adddays(1) & "# or Adj_EndTime is null)"

End If

End With

With e.Form.Controls("StartDate_WO")

If .Value IsNot Nothing Then

If Filter > "" Then

Filter = Filter & " And "

End If

Filter = Filter & "(DeliveryDate >= #" & .Value & "# or DeliveryDate is null)"

End If

End With

With e.Form.Controls("EndDate_WO")

If .Value IsNot Nothing Then

If Filter > "" Then

Filter = Filter & " And "

End If

Filter = Filter & "(DeliveryDate < #" & .Value.adddays(1) & "# or DeliveryDate is null)"

End If

End With

If e.Form.Controls("Ratio_OnGoing_COp").Checked = True Then \'本工序进行中

If Filter > "" Then

Filter = Filter & " And "

End If

If e.Form.Controls("CBox_Cell").Value = "采购组" Then

Filter = Filter & ( "OPStatus =\'OG\'")

Else

Filter = Filter & ( "OPStatus = \'G\'")

End If

ElseIf e.Form.Controls("Ratio_Uncmpt_COp").Checked = True Then \'本工序未开始

If Filter > "" Then

Filter = Filter & " And "

End If

If e.Form.Controls("CBox_Cell").Value = "采购组" Then

Filter = Filter & "(OPStatus Like \'O*\' OR OPStatus is null )"

Else

Filter = Filter & "(OPStatus in (\'W\',\'R\',\'U\',\'F\') or OPStatus is null) "

End If

ElseIf e.Form.Controls("Ratio_Uncmpt_COp1").Checked = True Then \'本工序进行中+未开始

If Filter > "" Then

Filter = Filter & " And "

End If

If e.Form.Controls("CBox_Cell").Value = "采购组" Then

Filter = Filter & ( "OPStatus like =\'O*\' OR OPStatus is null")

Else

Filter = Filter & "(OPStatus in (\'G\',\'W\',\'R\',\'U\',\'F\') or OPStatus is null) "

End If

ElseIf e.Form.Controls("Ratio_Cmpt_COp").Checked = True Then \'本工序已完成

If Filter > "" Then

Filter = Filter & " And "

End If

If e.Form.Controls("CBox_Cell").Value = "采购组" Then

Filter = Filter & "OPStatus =\'CO\'"

Else

Filter = Filter & ( "OPStatus like \'C*\' and OPStatus <>\'CO\'")

End If

If e.Form.Controls("Rbtn_NPI").Checked = True Then \'NPI/Mass

If Filter > "" Then

Filter = Filter & " And "

End If

Filter = Filter & "NPI = true"

End If

If e.Form.Controls("Rbtn_Mass").Checked = True Then \'NPI/Mass

If Filter > "" Then

Filter = Filter & " And "

End If

Filter = Filter & "NPI = false"

End If

\'MessageBox.Show("2Filter=" & Filter)

If e.Form.Controls("RBtn_OP_Delivery_M3").Checked = True Then \'工序停滞超过3天

If Filter > "" Then

Filter = Filter & " And "

End If

Filter = Filter & "StayDays > 3"

End If

\'MessageBox.Show("3Filter=" & Filter)

Dim bDate As Date

Dim eDate As Date

If e.Form.Controls("RBtn_PN_Delivery_M3").Checked = True Then \'产品交期超过3天

If Filter > "" Then

Filter = Filter & " And "

End If

bDate = Date.Today

eDate = Date.Today.AddDays( - 3)

Filter = Filter & "ProductDeliveryDate <= #" & eDate & "#"

End If

If e.Form.Controls("RBtn_PN_Delivery_M03").Checked = True Then \'产品交期3天以内（含超期2天至今）

If Filter > "" Then

Filter = Filter & " And "

End If

bDate = Date.Today.AddDays( - 2)

eDate = Date.Today.AddDays(3)

Filter = Filter & "ProductDeliveryDate >= #" & bDate & "# and ProductDeliveryDate <= #" & eDate & "#"

End If

If e.Form.Controls("RBtn_PN_Delivery_M5").Checked = True Then \'产品交期未来5天内

If Filter > "" Then

Filter = Filter & " And "

End If

bDate = Date.Today.AddDays(0)

eDate = Date.Today.AddDays(5)

Filter = Filter & "ProductDeliveryDate > #" & bDate & "# and ProductDeliveryDate <= #" & eDate & "#"

End If

If e.Form.Controls("CheckBox_Shippinglist").Checked = True Then \'当期（列入Shipping List）

If Filter > "" Then

Filter = Filter & " And "

End If

Filter = Filter & "ShippingRowSign = \'Y\'"

End If

If e.Form.Controls("CheckBox_R").Checked = True Then \'

If Filter > "" Then

Filter = Filter & " And "

End If

Filter = Filter & "OPStatus = \'R\'"

End If

\'MessageBox.Show(Filter)

If Loadtype = 1 Then \'动态加载

DataTables("INISecondarySchedule").LoadFilter = Filter

DataTables("INISecondarySchedule").Load

\'ElseIf LoadType = 2 Then \'预加载

End If

Dim r As DataRow = DataTables("Data").Find("文件更新_文件名 = \'BK_INI Production Schedule.xlsx\'")

e.Form.Controls("Label_Time").Text = "最近更新：" & Format(r("文件更新_时间"), "G")

\'排序

MessageBox.Show(Tables("INISecondarySchedule_Table1").Rows.Count)

If Tables("INISecondarySchedule_Table1").Rows.Count > 0 Then

If e.Form.Controls("Ratio_OPDeliveryDate").Checked = True Then \'工序交期排序

Tables("INISecondarySchedule_Table1").Sort = "Adj_StartTime"

ElseIf e.Form.Controls("Ratio_ShippingListDeliveryDate").Checked = True Then \'当期交付排序

Tables("INISecondarySchedule_Table1").Sort = "ShippingRowSign Desc, DeliveryDate"

ElseIf e.Form.Controls("Ratio_PNDeliveryDate").Checked = True Then \'产品交期排序

Tables("INISecondarySchedule_Table1").Sort = "DeliveryDate"

ElseIf e.Form.Controls("Ratio_NoSort").Checked = True Then

\'不进行排序操作

\'MessageBox.Show("不排序")

Tables("INISecondarySchedule_Table1").sort = ""

End If

Else

SystemReady = True

MessageBox.Show(1)

End if

Catch ex As Exception

SystemReady = True

MessageBox.Show (space(8) & ",确认请按[是/Yes],否则请退出......", "系统提示")

End Try

SystemReady = True

为了测试程序执行的步骤, 我增加了try...指令,并在其中设置了Messagebox.show 指令和SystemReady=True, 结果发现都没有运行到这个指令段.

求大师帮忙解决. 谢谢!