frmdpjzb.frm

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

            xlmc = RS(0)
         Else
            A = MsgBox("没有录入对应断路器的线路名称，请手动输入", vbDefaultButton2)
            'Exit Sub
         End If
         If RS.State Then
            RS.Close
         End If
         
         sql2 = "select cs02 from xdgl_sb_sbcsb where sbdl='" & Trim(List1.Text) & "' and sbmc='" & Trim(xlmc) & "'"
         
     Set RS = ZHCX.Execute(sql2, 0)
     Debug.Print sql2
     If Not RS.EOF Then
         If Not IsNull(RS(0)) Then
            dydj = RS(0)
         Else
            A = MsgBox("没有录入对应线路电压等级,请手动输入", vbDefaultButton2)
           ' Exit Sub
         End If
    End If
         If RS.State Then
            RS.Close
         End If
     DataGrid1.Columns(0).Value = ID
     DataGrid1.Columns(1).Value = Format(DTPicker1.Value, "yyyy-mm-dd") + " " + Format(Now, "hh:mm")
     DataGrid1.Columns(2).Value = Trim(List1.Text)
     DataGrid1.Columns(3).Value = xlmc
     DataGrid1.Columns(4).Value = Trim(List2.Text)
     DataGrid1.Columns(6).Value = Format(DTPicker1.Value, "yyyy-mm-dd") + " " + Format(Now, "hh:mm")
     DataGrid1.Columns(8).Value = dydj
     Adodc1.Recordset.Update
   Adodc1.Refresh
   DataGrid1.Refresh
   Call Close_link
   Call sx
        
End Sub

Private Sub Command2_Click()
A = MsgBox("是否确认删除该记录", vbYesNo)
 If A = 6 Then
     If Not Adodc1.Recordset.EOF Then
        Adodc1.Recordset.Delete
     Else
     Exit Sub
    End If
 Else
  Exit Sub
 End If
     Adodc1.Recordset.Update
     Adodc1.Refresh
     DataGrid1.Refresh
Call sx
End Sub

Private Sub Command3_Click()
If Check1.Value Then
    sql1 = "select * from xdgl_dpjzb where sj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by sj "
  Else
       If Check2.Value Then
           sql1 = "select * from xdgl_dpjzb where dwmc='" & Trim(List1.Text) & "'and sj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by sj"
       Else
           sql1 = "select * from xdgl_dpjzb where dwmc='" & Trim(List1.Text) & "' and kgbh='" & Trim(List2.Text) & "' and sj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by sj"
       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, 9).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 = "所切负荷(MW)"
           sendexcel.Cells(2, 6).Value = "复电时间"
           sendexcel.Cells(2, 7).Value = "备注"
           sendexcel.Cells(2, 8).Value = "停电时长(分钟)"
           sendexcel.Cells(2, 9).Value = "损失负荷"
           
           sendexcel.Columns("A:A").ColumnWidth = 16
           sendexcel.Columns("B:B").ColumnWidth = 9
           sendexcel.Columns("C:C").ColumnWidth = 9
           sendexcel.Columns("D:D").ColumnWidth = 5
           sendexcel.Columns("E:E").ColumnWidth = 9
           sendexcel.Columns("F:F").ColumnWidth = 16
           sendexcel.Columns("G:G").ColumnWidth = 12
           sendexcel.Columns("h:h").ColumnWidth = 12
           sendexcel.Columns("i:i").ColumnWidth = 12
         
           
       
    sendexcel.ActiveWindow.SmallScroll ToRight:=1
    sendexcel.ActiveWindow.SmallScroll ToRight:=-1
    sendexcel.Range("A2:i2").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:i").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("sj")))
                End If
                
                If IsNull(RS(2)) Then
                    sendexcel.Cells(j, 2).Value = ""
                Else
                    sendexcel.Cells(j, 2).Value = CStr(Trim(RS("dwmc")))
                End If
                
                If IsNull(RS(3)) Then
                    sendexcel.Cells(j, 3).Value = ""
                Else
                    sendexcel.Cells(j, 3).Value = CStr(Trim(RS("xlmc")))
                End If
                
                If IsNull(RS(4)) Then
                    sendexcel.Cells(j, 4).Value = ""
                Else
                    sendexcel.Cells(j, 4).Value = CStr(Trim(RS("kgbh")))
                End If
                If IsNull(RS(5)) Then
                    sendexcel.Cells(j, 5).Value = ""
                Else
                    sendexcel.Cells(j, 5).Value = CStr(Trim(RS("sqfh")))
                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("bz")))
                End If
                    sendexcel.Cells(j, 8).Value = "=24*60*(f" & CStr(j) & "-a" & CStr(j) & ")"
                    sendexcel.Cells(j, 9).Value = "=h" & CStr(j) & "*e" & CStr(j) & ""
            RS.MoveNext
            j = j + 1
       Loop
          s_a = "h3:i" & CStr(j - 1)
    sendexcel.Range(s_a).Select
    sendexcel.Selection.NumberFormatLocal = "0.000_ "
   s_a = "A2:i" & 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:H1").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("I1").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()
   DTPicker1.Value = Format(Now, "yyyy-mm-01")
 
   DTPicker2.Value = DateAdd("d", -1, DateAdd("m", 1, DTPicker1.Value))
   sql2 = "select * from xdgl_dpjzb where sj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by sj"
   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("厂站数据为空", vbDefaultButton2)
     End If
      If List2.ListCount > 0 Then
       List2.ListIndex = 0
     Else
       A = MsgBox("该厂站设备数据为空", vbDefaultButton2)
     End If
  'Adodc1.RecordSource = sql2
  Adodc1.Refresh
  DataGrid1.Refresh
     Call sx
     Call Close_link
     
End Sub
 
 Sub sx()
 Debug.Print Adodc1.RecordSource
 DataGrid1.Columns(0).Caption = "序号"
 DataGrid1.Columns(1).Caption = "时间"
 DataGrid1.Columns(2).Caption = "厂站"
 DataGrid1.Columns(3).Caption = "线路名称"
 DataGrid1.Columns(4).Caption = "断路器"
 DataGrid1.Columns(5).Caption = "所切负荷(MW)"
 DataGrid1.Columns(6).Caption = "复电时间"
 DataGrid1.Columns(7).Caption = "备注"
 DataGrid1.Columns(8).Visible = False
 DataGrid1.Columns(9).Visible = False
 End Sub

Private Sub List1_Click()
  sql2 = "select sbmc from xdgl_sb_sbcsb where sbxl='断路器' and  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 Check1.Value Then
    Adodc1.RecordSource = "select * from xdgl_dpjzb where sj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by sj"
  Else
    If Check2.Value Then
       Adodc1.RecordSource = "select * from xdgl_dpjzb where dwmc='" & Trim(List1.Text) & "' and sj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by sj"
    Else
       Adodc1.RecordSource = "select * from xdgl_dpjzb where dwmc='" & Trim(List1.Text) & "' and kgbh='" & Trim(List2.Text) & "' and sj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by sj"
    End If
  End If
  Adodc1.Refresh
  DataGrid1.Refresh
  Call sx
   If List2.ListCount <> 0 Then
      List2.ListIndex = 0
   End If
End Sub

Private Sub List2_Click()
  If Check1.Value Then
     Adodc1.RecordSource = "select * from xdgl_dpjzb where sj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by sj"
  Else
  Adodc1.RecordSource = "select * from xdgl_dpjzb where dwmc='" & Trim(List1.Text) & "' and kgbh='" & Trim(List2.Text) & "' and sj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by sj"
  End If
  Adodc1.Refresh
  DataGrid1.Refresh
  Call sx
End Sub