📄 frmplan_times.frm
字号:
VERSION 5.00
Object = "{86CF1D34-0C5F-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCT2.OCX"
Object = "{D959C709-8613-11D1-9840-002078110E7D}#1.0#0"; "as97Popup.ocx"
Object = "{C7AE747C-B9E4-11D7-B0E3-D8165009166E}#7.0#0"; "XPForm.ocx"
Begin VB.Form frmplan_times
BorderStyle = 0 'None
Caption = "计划次数查询"
ClientHeight = 5640
ClientLeft = 0
ClientTop = 0
ClientWidth = 6750
Icon = "frmplan_times.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5640
ScaleWidth = 6750
ShowInTaskbar = 0 'False
StartUpPosition = 3 '窗口缺省
Begin as97Popup.asPopup asPopup2
Height = 375
Left = 2880
Top = 3840
Width = 1095
_ExtentX = 1931
_ExtentY = 661
Caption = "退出"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ScaleWidth = 73
ScaleMode = 0
ScaleHeight = 25
End
Begin as97Popup.asPopup asPopup1
Height = 375
Left = 1200
Top = 3840
Width = 975
_ExtentX = 1720
_ExtentY = 661
Caption = "确定"
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "宋体"
Size = 9
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ScaleWidth = 65
ScaleMode = 0
ScaleHeight = 25
End
Begin VB.ComboBox Combo2
Height = 300
Left = 2520
TabIndex = 7
Text = "全部"
Top = 2880
Width = 1455
End
Begin VB.ComboBox Combo1
Height = 300
Left = 2520
TabIndex = 4
Text = "1"
Top = 2160
Width = 1575
End
Begin MSComCtl2.DTPicker DTPicker2
Height = 375
Left = 2520
TabIndex = 3
Top = 1320
Width = 1575
_ExtentX = 2778
_ExtentY = 661
_Version = 393216
Format = 62390273
CurrentDate = 37879
End
Begin MSComCtl2.DTPicker DTPicker1
Height = 375
Left = 2520
TabIndex = 0
Top = 600
Width = 1575
_ExtentX = 2778
_ExtentY = 661
_Version = 393216
Format = 62390273
CurrentDate = 37879
End
Begin XP窗体控件.XPForm XPForm1
Height = 1770
Left = 360
Top = 960
Width = 1920
_ExtentX = 3387
_ExtentY = 3122
Caption = "计划次数查询"
Icon = "frmplan_times.frx":08CA
AlwaysOnTop = 0 'False
ShowFormSize = 0 'False
End
Begin VB.Label Label5
Caption = "天"
Height = 255
Left = 4200
TabIndex = 8
Top = 2280
Width = 495
End
Begin VB.Label Label4
Caption = "查找类型"
Height = 375
Left = 960
TabIndex = 6
Top = 2880
Width = 975
End
Begin VB.Label Label3
Caption = "计划周期"
Height = 375
Left = 960
TabIndex = 5
Top = 2160
Width = 1095
End
Begin VB.Label Label2
Caption = "结束时间"
Height = 375
Left = 960
TabIndex = 2
Top = 1440
Width = 1095
End
Begin VB.Label Label1
Caption = "开始时间"
Height = 375
Left = 960
TabIndex = 1
Top = 720
Width = 1215
End
End
Attribute VB_Name = "frmplan_times"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim connectstring As String
Dim sqltxt As String
Private Sub asPopup1_Click(Cancel As Boolean)
Dim rs_1 As New ADODB.Recordset
Dim rs_2 As New ADODB.Recordset
Dim date_find_begin, date_find_end As String
Dim find_time As String
Dim i As Integer
Dim conn1 As New ADODB.Connection
Dim Xj_date, Xj_type, Xj_lc, Xj_planper, Xj_result, Xj_cir As String
Dim Xj_plantime, Xj_truetime As Integer
Dim totaltime As Integer
Dim Plan_time, true_time As String
Dim Allo_time As Integer
Dim year_time, mon_time, day_time As String
Dim begin_flag, end_flag As Integer
Dim Begin_date, End_date As Date
Dim find_time_End As String
Dim day_time_End As String
Dim length As Integer
'Dim totaltime As Integer
Dim month_Time_End As String
Dim flag_kk As Boolean
Dim flag_com As Boolean
flag_com = True
asPopup1.Enabled = False
asPopup2.Enabled = False
frmdelay.Label1.MsgChar = "正在分析,请您稍等"
frmdelay.Left = 4000
frmdelay.Top = 2500
frmdelay.Show
flag_kk = False
length = Combo1.Text
Xj_cir = length
Begin_date = DTPicker1
End_date = DTPicker2
totaltime = DateDiff("d", CDate(Begin_date), CDate(End_date))
connectstring = "provider=Microsoft.Jet.oledb.4.0;" & _
"data source=" & App.Path & "\jk.mdb"
conn.Open connectstring
conn.CursorLocation = adUseClient
sqltxt = "delete * from 次数执行表"
Set rs = conn.Execute(sqltxt)
Set rs = Nothing
Set conn = Nothing
year_time = Year(Begin_date)
If Len(year_time) = 2 Then
year_time = "20" & year_time
End If
mon_time = Month(Begin_date)
Dim begin_Month As Integer
begin_Month = Month(Begin_date)
Dim month_Day As Integer
If begin_Month = 1 Or begin_Month = 3 Or begin_Month = 5 Or begin_Month = 7 Or begin_Month = 8 Or begin_Month = 10 Or begin_Month = 12 Then
month_Day = 31
End If
If begin_Month = 4 Or begin_Month = 6 Or begin_Month = 9 Or begin_Month = 11 Then
month_Day = 30
End If
If begin_Month = 2 Then
If Year(Begin_date) Mod 4 = 0 Then
month_Day = 29
Else
month_Day = 28
End If
End If
If Len(mon_time) = 1 Then
mon_time = "0" & mon_time
End If
day_time = Day(Begin_date)
'day_time_End = day_time + length - 1
If Len(day_time) = 1 Then
day_time = "0" & day_time
End If
begin_flag = Day(Begin_date)
conn1.Open connectstring
month_Time_End = mon_time
Dim kk As Integer
kk = 0
Do While kk <= totaltime
If Len(begin_flag) = 1 Then
day_time = "0" & begin_flag
Else
day_time = begin_flag
End If
day_time_End = begin_flag + length - 1
If flag_com = True Then
If day_time_End > month_Day Then
flag_com = False
day_time_End = day_time_End - month_Day
month_Time_End = Month(End_date)
flag_kk = True
If Len(month_Time_End) = 1 Then
month_Time_End = "0" & month_Time_End
End If
End If
End If
If Len(day_time_End) = 1 Then
day_time_End = "0" & day_time_End
Else
day_time_End = day_time_End
End If
find_time = year_time & "/" & mon_time & "/" & day_time
find_time_End = year_time & "/" & month_Time_End & "/" & day_time_End
If flag_com = True Then
If day_time_End = month_Day Then
flag_com = False
day_time_End = day_time_End - month_Day
month_Time_End = Month(End_date)
flag_kk = True
If Len(month_Time_End) = 1 Then
month_Time_End = "0" & month_Time_End
End If
End If
End If
sqltxt = "select * from 计划次数表 order by 类型,地点"
Set rs_1 = conn1.Execute(sqltxt)
sqltxt = "select 采集器类型,地点,count(地点) as 次数 from 巡检结果表 where 巡检日期>='" & find_time & " ' and 巡检日期<='" & find_time_End & " ' group by 采集器类型,地点 order by 采集器类型,地点 "
Set rs_2 = conn1.Execute(sqltxt)
If rs_1.EOF And rs_1.BOF Then
Else
rs_1.MoveFirst
End If
If rs_2.EOF And rs_2.BOF Then
Else
rs_2.MoveFirst
End If
Do While rs_1.EOF <> True And rs_2.EOF <> True
'看是否是任何人可以
If rs_1.Fields("类型") = rs_2.Fields("采集器类型") And rs_1.Fields("地点") = rs_2.Fields("地点") Then '比较非漏情况
Xj_truetime = rs_2.Fields("次数")
Xj_plantime = rs_1.Fields("次数")
If Xj_truetime >= Xj_plantime Then
Xj_result = "合格"
Else
Xj_result = "不合格"
End If
Xj_date = find_time & "-" & find_time_End
Xj_type = rs_1.Fields("类型")
Xj_lc = rs_1.Fields("地点")
Xj_planper = rs_1.Fields("人员")
If Combo2.Text = "全部" Or Combo2.Text = Xj_result Then
sqltxt = "insert into 次数执行表 values ('" & Xj_date & "','" & Xj_type & "','" & Xj_lc & "','" & Xj_cir & "','" & Xj_planper & "','" & Xj_plantime & "' ,'" & Xj_truetime & "','" & Xj_result & "')"
conn1.Execute (sqltxt)
End If
rs_1.MoveNext
rs_2.MoveNext
Else ' 漏检
Xj_result = "不合格"
Xj_date = find_time & "-" & find_time_End
Xj_type = rs_1.Fields("类型")
Xj_lc = rs_1.Fields("地点")
Xj_planper = rs_1.Fields("人员")
Xj_truetime = "0"
Xj_plantime = rs_1.Fields("次数")
If Combo2.Text = "全部" Or Combo2.Text = Xj_result Then
sqltxt = "insert into 次数执行表 values ('" & Xj_date & "','" & Xj_type & "','" & Xj_lc & "','" & Xj_cir & "','" & Xj_planper & "','" & Xj_plantime & "' ,'" & Xj_truetime & "','" & Xj_result & "')"
conn1.Execute (sqltxt)
End If
rs_1.MoveNext
'rs_2.MoveNext
End If
Loop
Do While rs_1.EOF <> True
Xj_result = "不合格"
Xj_date = find_time & "-" & find_time_End
Xj_type = rs_1.Fields("类型")
Xj_lc = rs_1.Fields("地点")
Xj_planper = rs_1.Fields("人员")
Xj_truetime = "0"
Xj_plantime = rs_1.Fields("次数")
If Combo2.Text = "全部" Or Combo2.Text = Xj_result Then
sqltxt = "insert into 次数执行表 values ('" & Xj_date & "','" & Xj_type & "','" & Xj_lc & "','" & Xj_cir & "','" & Xj_planper & "','" & Xj_plantime & "' ,'" & Xj_truetime & "','" & Xj_result & "')"
conn1.Execute (sqltxt)
End If
rs_1.MoveNext
Loop
Set rs_1 = Nothing
Set rs_2 = Nothing
TimeDelay 500
If flag_kk = False Then
begin_flag = begin_flag + length
Else
begin_flag = day_time_End + 1
mon_time = Month(End_date)
End If
If Len(mon_time) = 1 Then
mon_time = "0" & mon_time
End If
kk = kk + length
Loop
conn1.Close
frmtimes_re.Show
asPopup1.Enabled = True
asPopup2.Enabled = True
TimeDelay 300
Unload frmdelay
End Sub
Private Sub asPopup2_Click(Cancel As Boolean)
Unload Me
End Sub
Private Sub Form_Load()
XPForm1.Make
Dim now_date As Date
Date = Now
DTPicker1.Value = Date
DTPicker2.Value = Date
Dim i As Integer
For i = 1 To 31
Combo1.AddItem i
Next
Combo2.AddItem "全部"
Combo2.AddItem "合格"
Combo2.AddItem "不合格"
End Sub
Private Sub Form_Unload(Cancel As Integer)
Set conn = Nothing
Set rs = Nothing
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -