frmlzxdb.frm

来自「县级电力调度管理信息系统。VB6.0开发。 DMIS调度子系统包括以下功能模块」· FRM 代码 · 共 823 行 · 第 1/2 页

FRM
823 行
字号
12
  DataGrid1.Columns(6).Value = Format(DTPicker1.Value, "yyyy-mm-dd") + " " + Format(Now, "hh:mm")
  DataGrid1.Columns(7).Value = Format(DTPicker1.Value, "yyyy-mm-dd") + " " + Format(Now, "hh:mm")
  DataGrid1.Columns(9).Value = dydj
  DataGrid1.Columns(0).Value = ID
  Adodc1.Recordset.Update
  Debug.Print Adodc1.RecordSource
  Adodc1.RecordSource = "select * from xdgl_lzxdb where bdz='" & Trim(List1.Text) & "' and xl='" & 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_lzxdb where tdsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tdsj"
  Else
       If Check2.Value Then
           sql1 = "select * from xdgl_lzxdb where bdz='" & Trim(List1.Text) & "'and tdsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tdsj"
       Else
           sql1 = "select * from xdgl_lzxdb where bdz='" & Trim(List1.Text) & "' and xl='" & Trim(List2.Text) & "' and tdsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tdsj"
       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
       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-183"
           sendexcel.Cells(2, 1).Value = "变电站"
           sendexcel.Cells(2, 2).Value = "断路器"
           sendexcel.Cells(2, 3).Value = "线路"
           sendexcel.Cells(2, 4).Value = "负荷(MW)"
           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 = 10
           sendexcel.Columns("D:D").ColumnWidth = 9
           sendexcel.Columns("E:E").ColumnWidth = 10
           sendexcel.Columns("F:F").ColumnWidth = 16
           sendexcel.Columns("G:G").ColumnWidth = 16
           sendexcel.Columns("H:H").ColumnWidth = 10
           sendexcel.Columns("i:i").ColumnWidth = 10
           sendexcel.Columns("j:j").ColumnWidth = 10
         
           
       
    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: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("bdz")))
                End If
                
                If IsNull(RS(3)) Then
                    sendexcel.Cells(j, 2).Value = ""
                Else
                    sendexcel.Cells(j, 2).Value = CStr(Trim(RS("dlqbh")))
                End If
                
                If IsNull(RS(2)) Then
                    sendexcel.Cells(j, 3).Value = ""
                Else
                    sendexcel.Cells(j, 3).Value = CStr(Trim(RS("xl")))
                End If
                
                If IsNull(RS(4)) Then
                    sendexcel.Cells(j, 4).Value = ""
                Else
                    sendexcel.Cells(j, 4).Value = CStr(Trim(RS("fh")))
                End If
                If IsNull(RS(5)) Then
                    sendexcel.Cells(j, 5).Value = ""
                Else
                    sendexcel.Cells(j, 5).Value = CStr(Trim(RS("xdyy")))
                End If
                If IsNull(RS(6)) Then
                    sendexcel.Cells(j, 6).Value = ""
                Else
                    sendexcel.Cells(j, 6).Value = CStr(Trim(RS("tdsj")))
                End If
                If IsNull(RS(7)) Then
                    sendexcel.Cells(j, 7).Value = ""
                Else
                    sendexcel.Cells(j, 7).Value = CStr(Trim(RS("fdsj")))
                End If
                If IsNull(RS(8)) Then
                    sendexcel.Cells(j, 8).Value = ""
                Else
                    sendexcel.Cells(j, 8).Value = CStr(Trim(RS("bz")))
                End If
                If IsNull(RS(9)) Then
                    sendexcel.Cells(j, 9).Value = ""
                Else
                    sendexcel.Cells(j, 9).Value = CStr(Trim(RS("dydj")))
                End If
                sendexcel.Cells(j, 10).Value = "=24*60*(g" & CStr(j) & "-f" & CStr(j) & ")"
            RS.MoveNext
            j = j + 1
       Loop
       
If RS.State Then
   RS.Close
End If
 sql1 = "SELECT DYDJ,SUM(FH),COUNT(DYDJ) From XDGL_LZXDB where tdsj between  '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' GROUP BY DYDJ ORDER BY DYDJ DESC "
Debug.Print sql1
 Set RS = ZHCX.Execute(sql1, 0)
        If Not RS.EOF Then
                j = j + 1
              sendexcel.Cells(j, 5).Value = "电压等级"
              sendexcel.Cells(j, 6).Value = "所切总负荷"
              sendexcel.Cells(j, 7).Value = "拉闸次数"
              sendexcel.Cells(j, 8).Value = "停电总时长(分钟)"
              sendexcel.Cells(j, 9).Value = "损失负荷"
              j = j + 1
             Do While Not RS.EOF
             
              sendexcel.Cells(j, 5).Value = RS(0)
              temp = 0
              If Not IsNull(RS(0)) Then
                   
                    Sql = "SELECT * From XDGL_LZXDB where tdsj between  '" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and '" & Format(DTPicker2.Value, "yyyy-mm-dd 23:59:59") & "' and dydj='" & Trim(RS(0)) & "' ORDER BY DYDJ DESC "
                    Set RS1 = ZHCX.Execute(Sql, 1)
                    Do While Not RS1.EOF
                       If IsDate(RS1("fdsj")) Then
                            temp = temp + CDbl(Abs((DateDiff("n", RS1("tdsj"), RS1("fdsj")))))
                       End If
                       RS1.MoveNext
                    Loop
                    If RS1.State Then
                       RS1.Close
                    End If
              End If
              sendexcel.Cells(j, 6).Value = RS(1)
              sendexcel.Cells(j, 7).Value = RS(2)
              sendexcel.Cells(j, 8).Value = CStr(temp)
              sendexcel.Cells(j, 9).Value = "=f" & CStr(j) & "*H" & CStr(j) & "/60"
                
              RS.MoveNext
              j = j + 1
          Loop
        End If
        If RS.State Then
        RS.Close
       End If
   s_a = "A2:j" & 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:I1").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("J1").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='厂站'"
 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
  Adodc1.Refresh
  Debug.Print Adodc1.RecordSource
  DataGrid1.Refresh
  Call sx
  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(6).Caption = "停电时间"
DataGrid1.Columns(7).Caption = "复电时间"
DataGrid1.Columns(8).Caption = "备注"
DataGrid1.Columns(9).Visible = False
DataGrid1.Columns(10).Visible = False

End Sub

Private Sub List1_Click()
 sql2 = "select sbmc from xdgl_sb_sbcsb where sbxl='线路' and sbdl='" & Trim(List1.Text) & "'"
 Call Open_link
 List2.Clear
 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
    If List2.ListCount > 0 Then
      List2.ListIndex = 0
    Else

    End If
    If Check1.Value Then
        Adodc1.RecordSource = "select * from xdgl_lzxdb where tdsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tdsj"
    Else
       If Check2.Value Then
          Adodc1.RecordSource = "select * from xdgl_lzxdb where bdz='" & Trim(List1.Text) & "' and tdsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tdsj"
       Else
          Adodc1.RecordSource = "select * from xdgl_lzxdb where bdz='" & Trim(List1.Text) & "' and xl='" & Trim(List2.Text) & "' and tdsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tdsj"
       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_lzxdb where tdsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tdsj"
    Else
       If Check2.Value Then
          Adodc1.RecordSource = "select * from xdgl_lzxdb where bdz='" & Trim(List1.Text) & "' and tdsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tdsj"
       Else
          Adodc1.RecordSource = "select * from xdgl_lzxdb where bdz='" & Trim(List1.Text) & "' and xl='" & Trim(List2.Text) & "' and tdsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tdsj"
       End If
    End If
  Adodc1.Refresh
  Debug.Print Adodc1.RecordSource
  DataGrid1.Refresh
  Call sx
End Sub
12

frmlzxdb.frm - 源码说明

本页面展示了「县级电力调度管理信息系统。VB6.0开发。 DMIS调度子系统包括以下功能模块：调度操作票管理、调度运行日志、调度交接班管理、调度值班管理、调度报表管理、调度文档、避峰拉闸限电管理等7个业务模块。」中的 frmlzxdb.frm 源码文件，采用 FRM 编程语言编写，共 823 行代码。您可以在线阅读完整代码内容，也可以返回资源详情页下载完整源码包进行本地学习和开发。

虫虫开发者社区收录了大量与电力调度相关的技术资源，包括源代码、技术文档、电路图等，是电子工程师和嵌入式开发者的专业学习平台。

⌨️ 快捷键说明

复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?