frmdlqtzb.frm

县级电力调度管理信息系统。VB6.0开发。 DMIS调度子系统包括以下功能模块：调度操作票管理、调度运行日志、调度交接班管理、调度值班管理、调度报表管理、调度文档、避峰拉闸限电管理等7个业务模块。

Attribute VB_Exposed = False
Dim sql1 As String
Dim sql2 As String
Dim sql3 As String
Dim sql4 As String
Dim RS As ADODB.Recordset

Private Sub Check1_Click()
If Check1.Value Then
  sql3 = "select * from xdgl_dlqtzb where tzsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' and bdz='" & Trim(List1.Text) & "' order by tzsj"
  Adodc1.RecordSource = sql3
  Adodc1.Refresh
  Call sx
 End If
 End Sub

Private Sub Check2_Click()
 If Check2.Value Then
     
        sql2 = "select * from xdgl_dlqtzb where tzsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tzsj"
     
         Adodc1.RecordSource = sql2
       Adodc1.Refresh
       Call sx
 End If
End Sub

Private Sub command1_Click(Index As Integer)
If Trim(List2.Text) <> "" Then
 Else
  A = MsgBox("没有断路器，不能添加", vbDefaultButton1)
  Exit Sub
End If
Adodc1.Recordset.AddNew
DataGrid1.Columns(2).Value = Trim(List2.Text)
DataGrid1.Columns(3).Value = Format(DTPicker1.Value, "yyyy-mm-dd") + " " + Format(Now, "hh:mm:ss")
DataGrid1.Columns(1).Value = Trim(List1.Text)
DataGrid1.Columns(6).Value = Format(DTPicker1.Value, "yyyy-mm-dd") + " " + Format(Now, "hh:mm:ss")
Call Open_link
sql1 = "SELECT MAX(ID) FROM XDGL_dlqtzb"
Set RS = ZHCX.Execute(sql1, 0)


        If Not IsNull(RS(0)) Then
          ID = Int(RS(0)) + 1
        Else
          ID = 1
        End If
        If RS.State Then
            RS.Close
        End If

  
DataGrid1.Columns(0).Value = ID
Adodc1.Recordset.Update
Call Close_link
Adodc1.Refresh
Call sx
End Sub

Private Sub Command2_Click(Index As Integer)
If Adodc1.Recordset.EOF Then
 ID = 0
Else
ID = Adodc1.Recordset.Fields(0)
End If
sql4 = "delete  from xdgl_dlqtzb where id=" & ID & ""
  A = MsgBox("是否确认删除该记录", vbYesNo)
  If A = 6 Then
     'Call Open_link
     'Set RS = ZHCX.Execute(sql4, 0)
     If Not Adodc1.Recordset.EOF Then
        Adodc1.Recordset.Delete
        Adodc1.Recordset.Update
     End If
     Adodc1.Refresh
     Call sx
     'Call Close_link
  Else
    Exit Sub
  End If
End Sub

Private Sub Command3_Click()
 If Check2.Value Then
    sql1 = "select * from xdgl_dlqtzb where tzsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tzsj"
  Else
       If Check1.Value Then
           sql1 = "select * from xdgl_dlqtzb where bdz='" & Trim(List1.Text) & "'and tzsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tzsj"
       Else
           sql1 = "select * from xdgl_dlqtzb where bdz='" & Trim(List1.Text) & "' and dlq='" & Trim(List2.Text) & "' and tzsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tzsj"
       End If
End If
 Debug.Print sql1
   Adodc1.RecordSource = sql1
   Adodc1.Refresh
   Call sx
End Sub

Private Sub Command4_Click()

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
       Call Open_link
        Set RS = ZHCX.Execute(sql1, 0)
        If RS.EOF Then
        
        Else
           sendexcel.Cells(1, 1).Value = "断路器跳闸记录"
           'sendexcel.Cells(1, 10).Value = "TY-SJ-184"
           sendexcel.Cells(2, 1).Value = "变电站"
           sendexcel.Cells(2, 2).Value = "断路器"
           sendexcel.Cells(2, 3).Value = "跳闸时间"
           sendexcel.Cells(2, 4).Value = "保护动作"
           sendexcel.Cells(2, 5).Value = "重合闸"
           sendexcel.Cells(2, 6).Value = "复电时间"
           sendexcel.Cells(2, 7).Value = "跳闸原因"
           sendexcel.Cells(2, 8).Value = "电压等级"
           sendexcel.Cells(2, 9).Value = "损失负荷"
           sendexcel.Cells(2, 10).Value = "停电时长(分钟)"
           
           sendexcel.Columns("A:A").ColumnWidth = 8
           sendexcel.Columns("B:B").ColumnWidth = 7
           sendexcel.Columns("C:C").ColumnWidth = 16.38
           sendexcel.Columns("D:D").ColumnWidth = 14
           sendexcel.Columns("E:E").ColumnWidth = 10
           sendexcel.Columns("F:F").ColumnWidth = 16.38
           sendexcel.Columns("G:G").ColumnWidth = 12
           sendexcel.Columns("h:h").ColumnWidth = 12
           sendexcel.Columns("i:i").ColumnWidth = 9
           sendexcel.Columns("j:j").ColumnWidth = 9.5
       
    sendexcel.ActiveWindow.SmallScroll ToRight:=1
    sendexcel.ActiveWindow.SmallScroll ToRight:=-1
    sendexcel.Range("A2:j2").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:j").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 = 3
        Do While Not RS.EOF
                If IsNull(RS(1)) Then
                    sendexcel.Cells(j, 1).Value = ""
                Else
                    sendexcel.Cells(j, 1).Value = CStr(Trim(RS("bdz")))
                End If
                
                If IsNull(RS(2)) Then
                    sendexcel.Cells(j, 2).Value = ""
                Else
                    sendexcel.Cells(j, 2).Value = CStr(Trim(RS("dlq")))
                End If
                
                If IsNull(RS(3)) Then
                    sendexcel.Cells(j, 3).Value = ""
                Else
                    sendexcel.Cells(j, 3).Value = CStr(Trim(RS("tzsj")))
                End If
                
                If IsNull(RS(4)) Then
                    sendexcel.Cells(j, 4).Value = ""
                Else
                    sendexcel.Cells(j, 4).Value = CStr(Trim(RS("bhdz")))
                End If
                If IsNull(RS(5)) Then
                    sendexcel.Cells(j, 5).Value = ""
                Else
                    sendexcel.Cells(j, 5).Value = CStr(Trim(RS("chzdz")))
                End If
                If IsNull(RS(6)) Then
                    sendexcel.Cells(j, 6).Value = ""
                Else
                    sendexcel.Cells(j, 6).Value = CStr(Trim(RS("fdsj")))
                End If
                If IsNull(RS(7)) Then
                    sendexcel.Cells(j, 7).Value = ""
                Else
                    sendexcel.Cells(j, 7).Value = CStr(Trim(RS("tzyy")))
                End If
                If IsNull(RS(10)) Then
                    sendexcel.Cells(j, 8).Value = ""
                Else
                    sendexcel.Cells(j, 8).Value = CStr(Trim(RS("dydj")))
                End If
                If IsNull(RS(11)) Then
                    sendexcel.Cells(j, 9).Value = ""
                Else
                    sendexcel.Cells(j, 9).Value = CStr(Trim(RS("ssfh")))
                End If

                If IsNull(RS("fdsj")) Then
                    sendexcel.Cells(j, 10).Value = ""
                Else
                    sendexcel.Cells(j, 10).Value = "=24*60*(f" & CStr(j) & "-c" & CStr(j) & ")"
                End If
            RS.MoveNext
            j = j + 1
       Loop
          If RS.State Then
           RS.Close
      End If
        sql1 = "select bdz,dlq,count(dlq) from xdgl_dlqtzb where tzsj between  '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "'  group by bdz,dlq "
        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 = "跳闸次数"
              'sendexcel.Cells(j, 7).Value = "损失负荷(WM)"
              sendexcel.Cells(j, 8).Value = "停电总时长(分钟)"
              sendexcel.Cells(j, 10).Value = "损失电量(kW.h)"
                s_a = "h" & CStr(j) & ":i" & CStr(j)
                        sendexcel.Range(s_a).Select
                        With sendexcel.Selection
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlBottom
                            .WrapText = False
                            .Orientation = 0
                            .AddIndent = False
                            .ShrinkToFit = False
                            .MergeCells = False
                    End With
                    sendexcel.Selection.Merge
              j = j + 1
             Do While Not RS.EOF
             
                    
                If Not IsNull(RS(0)) Then
                    temp = 0
                    Sql = "select * from xdgl_dlqtzb where tzsj between  '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and bdz='" & Trim(RS(0)) & "'  and dlq='" & Trim(RS(1)) & "' and dydj='110kV'"
                    Set RS2 = ZHCX.Execute(Sql, 1)
                 If Not RS2.EOF Then
                    Do While Not RS2.EOF
                        'Sql = "select * from xdgl_dlqtzb where tzsj between  '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and bdz='" & Trim(RS(0)) & "' and dlq='" & Trim(RS(1)) & "' and dydj='110kV' "
                        'Set RS1 = ZHCX.Execute(Sql, 1)
                        'Do While Not RS1.EOF
                            If IsDate(RS2("fdsj")) Then
                                temp = temp + CDbl(Abs((DateDiff("n", RS2("tzsj"), RS2("fdsj")))))
                            End If
                        '    RS1.MoveNext
                        'Loop
                        'If RS1.State Then
                        'RS1.Close
                        'End If
                        RS2.MoveNext
                    Loop
                      Sql = "select count(dlq),ssfh,TZSJ,FDSJ from xdgl_dlqtzb where tzsj between  '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and bdz='" & Trim(RS(0)) & "'  and dlq='" & Trim(RS(1)) & "' and dydj='110kV' GROUP BY SSFH,TZSJ,FDSJ"
                      If RS3.State Then
                         RS3.Close
                      End If
                      Set RS3 = ZHCX.Execute(Sql, 1)
                        sendexcel.Cells(j, 4).Value = Trim(RS(0))
                        sendexcel.Cells(j, 5).Value = Trim(RS(1))
                        sendexcel.Cells(j, 6).Value = CStr("110kV")
                        Sql = "select count(dlq) from xdgl_dlqtzb where tzsj between  '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and bdz='" & Trim(RS(0)) & "'  and dlq='" & Trim(RS(1)) & "' and dydj='110kV' "
                        If RS4.State Then
                           RS4.Close
                        End If
                        Set RS4 = ZHCX.Execute(Sql, 1)
                           
                        sendexcel.Cells(j, 7).Value = CStr(RS4(0))
                        If RS4.State Then
                           RS4.Close
                        End If
                        sendexcel.Cells(j, 8).Value = CStr(temp)
                        temp_DL = 0
                        Do While Not RS3.EOF
                            If IsDate(RS3("fdsj")) Then
                                temp1 = CDbl(Abs((DateDiff("n", RS3("tzsj"), RS3("fdsj")))))
                            End If
                            temp_DL = temp_DL + ((RS3(1)) * temp1) / 60 * 1000
                            RS3.MoveNext
                        Loop
                        sendexcel.Cells(j, 10).Value = CStr(temp_DL)
                        If RS3.State Then
                         RS3.Close
                        End If
                
                s_a = "h" & CStr(j) & ":i" & CStr(j)
                        sendexcel.Range(s_a).Select
                        With sendexcel.Selection
                            .HorizontalAlignment = xlCenter
                            .VerticalAlignment = xlBottom
                            .WrapText = False
                            .Orientation = 0
                            .AddIndent = False
                            .ShrinkToFit = False
                            .MergeCells = False
                    End With