📄 frm通信故障.frm
字号:
DataGrid1.Refresh
End If
Call sx
End Sub
Private Sub command1_Click()
If Trim(List2.Text) <> "" Then
Else
A = MsgBox("线路不能为空", vbDefaultButton2)
Exit Sub
End If
Call Open_link
sql4 = "select max(id) from xdgl_txgz"
Set RS = ZHCX.Execute(sql4, 0)
If Not IsNull(RS(0)) Then
ID = RS(0) + 1
RS.MoveNext
Else
ID = 1
End If
If RS.State Then
RS.Close
End If
If Err Then Err.Clear
Adodc1.Recordset.AddNew
DataGrid1.Columns(0).Value = ID
DataGrid1.Columns(1).Value = Trim(List1.Text)
DataGrid1.Columns(2).Value = Trim(List2.Text)
DataGrid1.Columns(4).Value = Format(DTPicker1.Value, "yyyy-mm-dd") + " " + Format(Now, "hh:mm")
DataGrid1.Columns(5).Value = Format(DTPicker1.Value, "yyyy-mm-dd") + " " + Format(Now, "hh:mm")
Adodc1.Recordset.Update
Debug.Print Adodc1.RecordSource
Adodc1.RecordSource = "select * from xdgl_txgz where cz='" & Trim(List1.Text) & "' and sb='" & Trim(List2.Text) & "'"
Debug.Print Adodc1.RecordSource
Adodc1.Refresh
DataGrid1.Refresh
Call sx
Call Close_link
End Sub
Private Sub Command2_Click()
A = MsgBox("是否真的删除该记录", vbYesNo)
If A = 6 Then
If Not Adodc1.Recordset.EOF Then
Adodc1.Recordset.Delete
End If
Else
Exit Sub
End If
Call Open_link
If Not Adodc1.Recordset.EOF Then
Adodc1.Recordset.Update
End If
Adodc1.Refresh
DataGrid1.Refresh
Call sx
Call Close_link
End Sub
Private Sub Command3_Click()
If Check1.Value Then
sql1 = "select * from xdgl_txgz where fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
If Check2.Value Then
sql1 = "select * from xdgl_txgz where cz='" & Trim(List1.Text) & "'and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
sql1 = "select * from xdgl_txgz where cz='" & Trim(List1.Text) & "' and sb='" & Trim(List2.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
End If
End If
Debug.Print sql1
Adodc1.RecordSource = sql1
Adodc1.Refresh
Call sx
End Sub
Private Sub Command5_Click()
Dim sendexcel As Excel.Application
Set sendexcel = CreateObject("excel.Application")
sendexcel.Visible = True
sendexcel.Workbooks.Add
sql1 = Adodc1.RecordSource
' Debug.Print sql1
Call Open_link
Set RS = ZHCX.Execute(sql1, 0)
If RS.EOF Then
Else
sendexcel.Cells(1, 1).Value = "厂站"
sendexcel.Cells(1, 2).Value = "设备名称"
sendexcel.Cells(1, 3).Value = "故障原因"
sendexcel.Cells(1, 4).Value = "发生时间"
sendexcel.Cells(1, 5).Value = "恢复时间"
sendexcel.Cells(1, 6).Value = "时长(分钟)"
sendexcel.Columns("A:A").ColumnWidth = 8
sendexcel.Columns("B:B").ColumnWidth = 8
sendexcel.Columns("C:C").ColumnWidth = 20
sendexcel.Columns("D:D").ColumnWidth = 16
sendexcel.Columns("E:E").ColumnWidth = 16
sendexcel.Columns("f:f").ColumnWidth = 18
sendexcel.ActiveWindow.SmallScroll ToRight:=1
sendexcel.ActiveWindow.SmallScroll ToRight:=-1
sendexcel.Range("A1:f1").Select
With sendexcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
With sendexcel.Selection.Interior
.ColorIndex = 42
.Pattern = xlSolid
End With
sendexcel.Selection.Font.ColorIndex = 11
sendexcel.Selection.Font.Bold = True
sendexcel.Columns("A:f").Select
With sendexcel.Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
With sendexcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
sendexcel.Cells.Select
With sendexcel.Selection
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
sendexcel.Range("D5").Select
j = 2
Do While Not RS.EOF
If IsNull(RS(1)) Then
sendexcel.Cells(j, 1).Value = ""
Else
sendexcel.Cells(j, 1).Value = CStr(Trim(RS("cz")))
End If
If IsNull(RS(2)) Then
sendexcel.Cells(j, 2).Value = ""
Else
sendexcel.Cells(j, 2).Value = CStr(Trim(RS("sb")))
End If
If IsNull(RS(4)) Then
sendexcel.Cells(j, 4).Value = ""
Else
sendexcel.Cells(j, 4).Value = CStr(Trim(RS("fssj")))
End If
If IsNull(RS(5)) Then
sendexcel.Cells(j, 5).Value = ""
Else
sendexcel.Cells(j, 5).Value = CStr(Trim(RS("hfsj")))
End If
If IsNull(RS(3)) Then
sendexcel.Cells(j, 3).Value = ""
Else
sendexcel.Cells(j, 3).Value = CStr(Trim(RS("gzyy")))
End If
sendexcel.Cells(j, 6).Value = "=24*60*(e" & CStr(j) & "-d" & CStr(j) & ")"
RS.MoveNext
j = j + 1
Loop
If RS.State Then
RS.Close
End If
sql1 = "SELECT CZ,SB,COUNT(SB) From xdgl_txgz where FSSJ between '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' GROUP BY CZ,SB "
Debug.Print sql1
Set RS = ZHCX.Execute(sql1, 0)
If Not RS.EOF Then
j = j + 1
sendexcel.Cells(j, 3).Value = "厂站"
sendexcel.Cells(j, 4).Value = "设备名称"
sendexcel.Cells(j, 5).Value = "故障次数"
sendexcel.Cells(j, 6).Value = "故障时长(分钟)"
j = j + 1
Do While Not RS.EOF
sendexcel.Cells(j, 3).Value = RS(0)
sendexcel.Cells(j, 4).Value = RS(1)
sendexcel.Cells(j, 5).Value = RS(2)
temp = 0
If Not IsNull(RS(0)) Then
Sql = "SELECT * From XDGL_TXGZ where fssj between '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and cz='" & Trim(RS(0)) & "' and sb='" & Trim(RS(1)) & "'"
Set RS1 = ZHCX.Execute(Sql, 1)
Do While Not RS1.EOF
If IsDate(RS1("hfsj")) Then
temp = temp + CDbl(Abs((DateDiff("n", RS1("fssj"), RS1("hfsj")))))
End If
RS1.MoveNext
Loop
If RS1.State Then
RS1.Close
End If
End If
sendexcel.Cells(j, 6).Value = CStr(temp)
RS.MoveNext
j = j + 1
Loop
End If
If RS.State Then
RS.Close
End If
s_a = "A1:f" & 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.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='厂站'"
Call Open_link
List1.Clear
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("厂站数据没有录入", vbDefaultButton2)
End If
List2.AddItem "光纤"
List2.AddItem "微波"
List2.AddItem "载波"
List2.AddItem "总机"
List2.AddItem "有线"
Adodc1.Refresh
Debug.Print Adodc1.RecordSource
DataGrid1.Refresh
Call sx
Call Close_link
End Sub
Sub sx()
DataGrid1.Columns(0).Visible = False
DataGrid1.Columns(1).Caption = "厂站"
DataGrid1.Columns(2).Caption = "设备"
DataGrid1.Columns(3).Caption = "故障原因"
DataGrid1.Columns(4).Caption = "发生时间"
DataGrid1.Columns(5).Caption = "恢复时间"
DataGrid1.Columns(6).Visible = False
End Sub
Private Sub List1_Click()
If List2.ListCount > 0 Then
List2.ListIndex = 0
Else
End If
If Check1.Value Then
Adodc1.RecordSource = "select * from xdgl_txgz where fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
If Check2.Value Then
Adodc1.RecordSource = "select * from xdgl_txgz where cz='" & Trim(List1.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
Adodc1.RecordSource = "select * from xdgl_txgz where cz='" & Trim(List1.Text) & "' and sb='" & Trim(List2.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
End If
End If
Adodc1.Refresh
Debug.Print Adodc1.RecordSource
DataGrid1.Refresh
Call Close_link
Call sx
End Sub
Private Sub List2_Click()
If Check1.Value Then
Adodc1.RecordSource = "select * from xdgl_txgz where fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
If Check2.Value Then
Adodc1.RecordSource = "select * from xdgl_txgz where cz='" & Trim(List1.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
Else
Adodc1.RecordSource = "select * from xdgl_txgz where cz='" & Trim(List1.Text) & "' and sb='" & Trim(List2.Text) & "' and fssj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by fssj"
End If
End If
Adodc1.Refresh
Debug.Print Adodc1.RecordSource
DataGrid1.Refresh
Call sx
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -