📄 frmtdtzb.frm
字号:
.Pattern = xlSolid
End With
myxlsapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
myxlsapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
myxlsapp.Columns("A:J").Select
With myxlsapp.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
' myxlsapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
' myxlsapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
' With myxlsapp.Selection.Borders(xlEdgeLeft)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
' With myxlsapp.Selection.Borders(xlEdgeTop)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
' With myxlsapp.Selection.Borders(xlEdgeBottom)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
' With myxlsapp.Selection.Borders(xlEdgeRight)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
' With myxlsapp.Selection.Borders(xlInsideVertical)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
' With myxlsapp.Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
j = 3
Do While Not RS.EOF
For i = 0 To RS.Fields.Count - 3
If IsNull(RS(i)) Then
myxlsapp.Cells(j, i + 1).Value = ""
Else
myxlsapp.Cells(j, i + 1).Value = Trim(RS(i))
End If
Next i
If IsNull(RS(8)) Then
myxlsapp.Cells(j, 9).Value = ""
Else
myxlsapp.Cells(j, 9).Value = Trim(RS(8))
End If
If IsNull(RS(9)) Then
myxlsapp.Cells(j, 8).Value = ""
Else
myxlsapp.Cells(j, 8).Value = Trim(RS(9))
End If
myxlsapp.Cells(j, 10).Value = "=24*60*(D" & CStr(j) & "-C" & CStr(j) & ")"
RS.MoveNext
j = j + 1
Loop
If RS.State Then
RS.Close
End If
' s_a = "A2:J" & CStr(j - 1)
' myxlsapp.Range(s_a).Select
' myxlsapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
' myxlsapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
' With myxlsapp.Selection.Borders(xlEdgeLeft)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
' With myxlsapp.Selection.Borders(xlEdgeTop)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
' With myxlsapp.Selection.Borders(xlEdgeBottom)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
' With myxlsapp.Selection.Borders(xlEdgeRight)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
' With myxlsapp.Selection.Borders(xlInsideVertical)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
' With myxlsapp.Selection.Borders(xlInsideHorizontal)
' .LineStyle = xlContinuous
' .Weight = xlThin
' .ColorIndex = xlAutomatic
' End With
sql1 = "select distinct(XZ) from xdgl_yhtzb where tzsj 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
myxlsapp.Cells(j, 6).Value = "停电性质"
myxlsapp.Cells(j, 7).Value = "电压等级"
myxlsapp.Cells(j, 8).Value = "停电总时长(分钟)"
s_a = "h" & CStr(j) & ":j" & CStr(j)
myxlsapp.Range(s_a).Select
With myxlsapp.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
myxlsapp.Selection.Merge
j = j + 1
Do While Not RS.EOF
If Not IsNull(RS(0)) Then
temp = 0
Sql = "select * from xdgl_yhtzb where tzsj between '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and xz='" & Trim(RS(0)) & "' and dydj='110kV'"
Set RS2 = ZHCX.Execute(Sql, 1)
i = 0
Do While Not RS2.EOF
Sql = "select * from xdgl_yhtzb where tzsj between '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and xz='" & Trim(RS(0)) & "'and dydj='110kV' "
Set RS1 = ZHCX.Execute(Sql, 1)
Do While Not RS1.EOF
If IsDate(RS1("jsjxsj")) Then
temp = temp + CDbl(Abs((DateDiff("n", RS1("jxsj"), RS1("jsjxsj")))))
End If
RS1.MoveNext
Loop
If RS1.State Then
RS1.Close
End If
RS2.MoveNext
i = i + 1
Loop
If i <> 0 Then
temp = temp / i
Else
temp = temp
End If
myxlsapp.Cells(j, 6).Value = Trim(RS(0))
myxlsapp.Cells(j, 7).Value = CStr("110kV")
myxlsapp.Cells(j, 8).Value = CStr(temp)
s_a = "h" & CStr(j) & ":j" & CStr(j)
myxlsapp.Range(s_a).Select
With myxlsapp.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
myxlsapp.Selection.Merge
j = j + 1
If RS2.State Then
RS2.Close
End If
temp = 0
Sql = "select * from xdgl_yhtzb where tzsj between '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and xz='" & Trim(RS(0)) & "' and dydj='35kV'"
Set RS2 = ZHCX.Execute(Sql, 1)
i = 0
Do While Not RS2.EOF
Sql = "select * from xdgl_yhtzb where tzsj between '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and xz='" & Trim(RS(0)) & "' and dydj='35kV' "
Set RS1 = ZHCX.Execute(Sql, 1)
Do While Not RS1.EOF
If IsDate(RS1("jsjxsj")) Then
temp = temp + CDbl(Abs((DateDiff("n", RS1("jxsj"), RS1("jsjxsj")))))
End If
RS1.MoveNext
Loop
If RS1.State Then
RS1.Close
End If
RS2.MoveNext
i = i + 1
Loop
If i <> 0 Then
temp = temp / i
Else
temp = temp
End If
myxlsapp.Cells(j, 6).Value = Trim(RS(0))
myxlsapp.Cells(j, 7).Value = CStr("35kV")
myxlsapp.Cells(j, 8).Value = CStr(temp)
s_a = "h" & CStr(j) & ":j" & CStr(j)
myxlsapp.Range(s_a).Select
With myxlsapp.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
myxlsapp.Selection.Merge
j = j + 1
If RS2.State Then
RS2.Close
End If
temp = 0
Sq2 = "select * from xdgl_yhtzb where tzsj between '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and xz='" & Trim(RS(0)) & "' and dydj='10kV'"
Set RS2 = ZHCX.Execute(Sq2, 1)
i = 0
Do While Not RS2.EOF
Sql = "select * from xdgl_yhtzb where tzsj between '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and xz='" & Trim(RS(0)) & "' and dydj='10kV'"
Set RS1 = ZHCX.Execute(Sql, 1)
Do While Not RS1.EOF
If IsDate(RS1("jsjxsj")) Then
temp = temp + CDbl(Abs((DateDiff("n", RS1("jxsj"), RS1("jsjxsj")))))
End If
RS1.MoveNext
Loop
If RS1.State Then
RS1.Close
End If
RS2.MoveNext
i = i + 1
Loop
If RS2.State Then
RS2.Close
End If
If i <> 0 Then
temp = temp / i
Else
temp = temp
End If
myxlsapp.Cells(j, 6).Value = Trim(RS(0))
myxlsapp.Cells(j, 7).Value = CStr("10kV")
myxlsapp.Cells(j, 8).Value = CStr(temp)
s_a = "h" & CStr(j) & ":j" & CStr(j)
myxlsapp.Range(s_a).Select
With myxlsapp.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
myxlsapp.Selection.Merge
j = j + 1
End If
RS.MoveNext
Loop
End If
If RS.State Then
RS.Close
End If
End If
If RS.State Then
RS.Close
End If
s_a = "A2:J" & CStr(j - 1)
myxlsapp.Range(s_a).Select
myxlsapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
myxlsapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With myxlsapp.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With myxlsapp.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With myxlsapp.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With myxlsapp.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With myxlsapp.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With myxlsapp.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
myxlsapp.Rows("1:1").RowHeight = 27
myxlsapp.Range("A1:j1").Select
myxlsapp.ActiveWindow.SmallScroll ToRight:=1
With myxlsapp.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
myxlsapp.Selection.Merge
With myxlsapp.Selection.Font
.Name = "楷体_GB2312"
.FontStyle = "加粗"
.Size = 24
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
myxlsapp.Range("j1").Select
myxlsapp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
myxlsapp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
myxlsapp.Selection.Borders(xlEdgeLeft).LineStyle = xlNone
myxlsapp.Selection.Borders(xlEdgeTop).LineStyle = xlNone
With myxlsapp.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
myxlsapp.Selection.Borders(xlEdgeRight).LineStyle = xlNone
Call Close_link
Set myxlsapp = Nothing
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))
Adodc1.RecordSource = "select * from xdgl_yhtzb where tzsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by id"
Adodc1.Refresh
Call c_Load
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -