📄 frmqxjlb.frm
字号:
Else
sendexcel.Cells(j, 3).Value = CStr(Trim(RS("dwmc")))
End If
If IsNull(RS(2)) Then
sendexcel.Cells(j, 4).Value = ""
Else
sendexcel.Cells(j, 4).Value = CStr(Trim(RS("sbxl")))
End If
If IsNull(RS(4)) Then
sendexcel.Cells(j, 5).Value = ""
Else
sendexcel.Cells(j, 5).Value = CStr(Trim(RS("sbmc")))
End If
If IsNull(RS(7)) Then
sendexcel.Cells(j, 6).Value = ""
Else
sendexcel.Cells(j, 6).Value = CStr(Trim(RS("xxqk")))
End If
If IsNull(RS(10)) Then
sendexcel.Cells(j, 2).Value = ""
Else
sendexcel.Cells(j, 2).Value = CStr(Trim(RS("clsj")))
End If
If IsNull(RS(11)) Then
sendexcel.Cells(j, 7).Value = ""
Else
sendexcel.Cells(j, 7).Value = CStr(Trim(RS("bz")))
End If
RS.MoveNext
j = j + 1
Loop
sql1 = "select distinct(dwmc) from xdgl_qxjlb where fssj between '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' "
Debug.Print sql1
Set RS = ZHCX.Execute(sql1, 0)
If Not RS.EOF Then
j = j + 1
sendexcel.Cells(j, 4).Value = "厂站"
sendexcel.Cells(j, 5).Value = "设备名称"
sendexcel.Cells(j, 6).Value = "设备编号"
sendexcel.Cells(j, 7).Value = "次数"
j = j + 1
Do While Not RS.EOF
sendexcel.Cells(j, 4).Value = Trim(RS(0))
sql1 = "select distinct(sbxl) from xdgl_qxjlb where fssj between '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and dwmc='" & Trim(RS(0)) & "' "
Set RS1 = ZHCX.Execute(sql1, 1)
Do While Not RS1.EOF
sql1 = "select distinct(sbmc) from xdgl_qxjlb where fssj between '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and dwmc='" & Trim(RS(0)) & "' and sbxl='" & Trim(RS1(0)) & "' "
Set RS2 = ZHCX.Execute(sql1, 1)
Do While Not RS2.EOF
sendexcel.Cells(j, 4).Value = Trim(RS(0))
sendexcel.Cells(j, 5).Value = Trim(RS1(0))
sendexcel.Cells(j, 6).Value = Trim(RS2(0))
Sql = "select count(sbmc) from xdgl_qxjlb where fssj between '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and dwmc='" & Trim(RS(0)) & "' and sbxl='" & Trim(RS1(0)) & "' and sbmc='" & Trim(RS2(0)) & "' "
Set RS3 = ZHCX.Execute(Sql, 1)
If Not RS3.EOF Then
sendexcel.Cells(j, 7).Value = RS3(0)
End If
If RS3.State Then
RS3.Close
End If
RS2.MoveNext
j = j + 1
Loop
If RS2.State Then
RS2.Close
End If
RS1.MoveNext
Loop
If RS1.State Then
RS1.Close
End If
RS.MoveNext
Loop
End If
If RS.State Then
RS.Close
End If
s_a = "A2:G" & CStr(j - 1)
sendexcel.Range(s_a).Select
sendexcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
sendexcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With sendexcel.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With sendexcel.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With sendexcel.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With sendexcel.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With sendexcel.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With sendexcel.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
sendexcel.Rows("1:1").RowHeight = 27
sendexcel.Range("A1:F1").Select
sendexcel.ActiveWindow.SmallScroll ToRight:=1
With sendexcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
sendexcel.Selection.Merge
With sendexcel.Selection.Font
.Name = "楷体_GB2312"
.FontStyle = "加粗"
.Size = 24
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
sendexcel.Range("G1").Select
sendexcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
sendexcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
sendexcel.Selection.Borders(xlEdgeLeft).LineStyle = xlNone
sendexcel.Selection.Borders(xlEdgeTop).LineStyle = xlNone
With sendexcel.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
sendexcel.Selection.Borders(xlEdgeRight).LineStyle = xlNone
sendexcel.Range("D5").Select
End If
Call Close_link
End Sub
Private Sub Form_Load()
On Error Resume Next
DTPicker1.Value = Format(Now, "yyyy-mm-01")
DTPicker2.Value = DateAdd("d", -1, DateAdd("m", 1, DTPicker1.Value))
sql1 = "select sbmc from xdgl_sblx where sblx='厂站'"
List1.Clear
Call Open_link
Set RS = ZHCX.Execute(sql1, 0)
Do While Not RS.EOF
If IsNull(RS(0)) Then
Else
List1.AddItem RS(0)
End If
RS.MoveNext
Loop
If RS.State Then
RS.Close
End If
If List1.ListCount > 0 Then
List1.ListIndex = 0
Else
A = MsgBox("厂站数据没有记录", vbDefaultButton1)
Exit Sub
End If
Call Close_link
End Sub
Sub sx()
DataGrid1.Columns(0).Caption = "序号"
DataGrid1.Columns(1).Caption = "发生时间"
DataGrid1.Columns(2).Caption = "单位名称"
DataGrid1.Columns(3).Caption = "设备类型"
DataGrid1.Columns(4).Caption = "设备编号"
DataGrid1.Columns(5).Caption = "汇报人"
DataGrid1.Columns(5).Visible = False
DataGrid1.Columns(6).Caption = "受理人"
DataGrid1.Columns(6).Visible = False
DataGrid1.Columns(7).Caption = "详细内容"
DataGrid1.Columns(8).Caption = "受理人"
DataGrid1.Columns(9).Caption = "汇报人"
DataGrid1.Columns(10).Caption = "处理时间"
DataGrid1.Columns(11).Caption = "备注"
DataGrid1.Columns(12).Visible = False
DataGrid1.Columns(13).Visible = False
DataGrid1.Columns(14).Visible = False
DataGrid1.Columns(15).Visible = False
DataGrid1.Columns(16).Visible = False
End Sub
Private Sub List1_Click()
sql2 = "select distinct sbxl from xdgl_sb_sbcsb where sbdl='" & Trim(List1.Text) & "'"
List2.Clear
Call Open_link
Set RS = ZHCX.Execute(sql2, 0)
Do While Not RS.EOF
If IsNull(RS(0)) Then
Else
List2.AddItem RS(0)
End If
RS.MoveNext
Loop
If RS.State Then
RS.Close
End If
Call Close_link
If List2.ListCount > 0 Then
List2.ListIndex = 0
Else
End If
If Check1.Value Then
sql1 = "select * from xdgl_qxjlb where fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
If Check2.Value Then
sql1 = "select * from xdgl_qxjlb where dwmc='" & Trim(List1.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
If Check3.Value Then
sql1 = "select * from xdgl_qxjlb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
sql1 = "select * from xdgl_qxjlb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "' and sbmc='" & Trim(List3.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
End If
End If
End If
Adodc1.RecordSource = sql1
Adodc1.Refresh
DataGrid1.Refresh
Call sx
End Sub
Private Sub List2_Click()
sql2 = "select distinct sbmc from xdgl_sb_sbcsb where sbdl='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "'"
List3.Clear
Call Open_link
Set RS = ZHCX.Execute(sql2, 0)
Do While Not RS.EOF
If IsNull(RS(0)) Then
Else
List3.AddItem RS(0)
End If
RS.MoveNext
Loop
If RS.State Then
RS.Close
End If
Call Close_link
If List3.ListCount > 0 Then
List3.ListIndex = 0
End If
If Check1.Value Then
sql1 = "select * from xdgl_qxjlb where fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
If Check2.Value Then
sql1 = "select * from xdgl_qxjlb where dwmc='" & Trim(List1.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
If Check3.Value Then
sql1 = "select * from xdgl_qxjlb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
sql1 = "select * from xdgl_qxjlb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "' and sbmc='" & Trim(List3.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
End If
End If
End If
Adodc1.RecordSource = sql1
Adodc1.Refresh
DataGrid1.Refresh
Call sx
End Sub
Private Sub List3_Click()
If Check1.Value Then
sql1 = "select * from xdgl_qxjlb where fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
If Check2.Value Then
sql1 = "select * from xdgl_qxjlb where dwmc='" & Trim(List1.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
If Check3.Value Then
sql1 = "select * from xdgl_qxjlb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
sql1 = "select * from xdgl_qxjlb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "' and sbmc='" & Trim(List3.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
End If
End If
End If
Adodc1.RecordSource = sql1
Adodc1.Refresh
DataGrid1.Refresh
Call sx
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -