frmbhdzbgb.frm

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

            End If
        End If
    End If
    Adodc1.RecordSource = sql2
    Adodc1.Refresh
    DataGrid1.Refresh
  Call sx
End Sub

Private Sub command1_Click(Index As Integer)
   If Trim(List3.Text) <> "" Then
   Else
     A = MsgBox("没有设备编号不能添加记录", vbDefaultButton2)
     Exit Sub
   End If
   sql4 = "select max(id) from xdgl_bhdzbgb"
   Call Open_link
   Set RS = ZHCX.Execute(sql4, 0)
      If Not IsNull(RS(0)) Then
          ID = RS(0) + 1
      Else
          ID = 1
      End If
      If RS.State Then
         RS.Close
      End If
      Adodc1.Recordset.AddNew
      DataGrid1.Columns(0).Value = ID
      DataGrid1.Columns(1).Value = Trim(List1.Text)
      DataGrid1.Columns(2).Value = Trim(List2.Text)
      DataGrid1.Columns(3).Value = Trim(List3.Text)
      DataGrid1.Columns(9).Value = Format(DTPicker1.Value, "yyyy-mm-dd") + " " + Format(Now, "hh:mm")
      DataGrid1.Columns(12).Value = Format(DTPicker2.Value, "yyyy-mm-dd") + " " + Format(Now, "hh:mm")
      Adodc1.Recordset.Update
      Adodc1.Refresh
      DataGrid1.Refresh
      Call Close_link
      Call sx
End Sub

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

Private Sub Command3_Click(Index As Integer)
    If Check1.Value Then
       sql2 = "select * from xdgl_bhdzbgb where slsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "'"
    Else
       If Check2.Value Then
           sql2 = "select * from xdgl_bhdzbgb where dwmc='" & Trim(List1.Text) & "'and slsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by SLSJ"
       Else
           If Check3.Value Then
               sql2 = "select * from xdgl_bhdzbgb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "'and slsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by SLSJ"
            Else
               sql2 = "select * from xdgl_bhdzbgb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "' and sbbh='" & Trim(List3.Text) & "'and slsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by SLSJ"
            End If
        End If
    End If
    Adodc1.RecordSource = sql2
    Adodc1.Refresh
    DataGrid1.Refresh
  Call sx
End Sub

Private Sub Command4_Click(Index As Integer)

End Sub

Private Sub Command5_Click(Index As Integer)
   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-177"
           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.Columns("A:A").ColumnWidth = 8
           sendexcel.Columns("B:B").ColumnWidth = 8
           sendexcel.Columns("C:C").ColumnWidth = 10
           sendexcel.Columns("D:D").ColumnWidth = 10
           sendexcel.Columns("E:E").ColumnWidth = 10
           sendexcel.Columns("F:F").ColumnWidth = 8
           sendexcel.Columns("G:G").ColumnWidth = 8
           sendexcel.Columns("H:H").ColumnWidth = 16.38
           sendexcel.Columns("I:I").ColumnWidth = 16.38
           
       
    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
            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("dwmc")))
                End If
                
                If IsNull(RS(3)) Then
                    sendexcel.Cells(j, 2).Value = ""
                Else
                    sendexcel.Cells(j, 2).Value = CStr(Trim(RS("sbbh")))
                End If
                
                If IsNull(RS(4)) Then
                    sendexcel.Cells(j, 3).Value = ""
                Else
                    sendexcel.Cells(j, 3).Value = CStr(Trim(RS("bhlx")))
                End If
                
                If IsNull(RS(5)) Then
                    sendexcel.Cells(j, 4).Value = ""
                Else
                    sendexcel.Cells(j, 4).Value = CStr(Trim(RS("tzqdz")))
                End If
                If IsNull(RS(6)) Then
                    sendexcel.Cells(j, 5).Value = ""
                Else
                    sendexcel.Cells(j, 5).Value = CStr(Trim(RS("tzhdz")))
                End If
                If IsNull(RS(7)) Then
                    sendexcel.Cells(j, 6).Value = ""
                Else
                    sendexcel.Cells(j, 6).Value = CStr(Trim(RS("flr")))
                End If
                If IsNull(RS(8)) Then
                    sendexcel.Cells(j, 7).Value = ""
                Else
                    sendexcel.Cells(j, 7).Value = CStr(Trim(RS("slngr")))
                End If
                If IsNull(RS(9)) Then
                    sendexcel.Cells(j, 8).Value = ""
                Else
                    sendexcel.Cells(j, 8).Value = CStr(Trim(RS("slsj")))
                End If
                If IsNull(RS(12)) Then
                    sendexcel.Cells(j, 9).Value = ""
                Else
                    sendexcel.Cells(j, 9).Value = CStr(Trim(RS("hbsj")))
                End If
           
            RS.MoveNext
            j = j + 1
       Loop
   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
    
       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))
  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
        Call MsgBox("厂站数据没有记录", vbDefaultButton2)
    End If
  Call Close_link
  Call sx
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).Caption = "受令时间"
DataGrid1.Columns(10).Caption = "汇报人"
DataGrid1.Columns(11).Caption = "受理人"
DataGrid1.Columns(10).Visible = False
DataGrid1.Columns(11).Visible = False
DataGrid1.Columns(12).Caption = "汇报时间"
DataGrid1.Columns(13).Visible = False
DataGrid1.Columns(14).Caption = "发令人单位"
DataGrid1.Columns(15).Caption = "受令人单位"
DataGrid1.Columns(16).Caption = "汇报人单位"
DataGrid1.Columns(17).Caption = "受理人单位"
DataGrid1.Columns(14).Visible = False
DataGrid1.Columns(15).Visible = False
DataGrid1.Columns(16).Visible = False
DataGrid1.Columns(17).Visible = False
End Sub

Private Sub List1_Click()
 sql1 = "select distinct sbxl from xdgl_sb_sbcsb where sbdl='" & Trim(List1.Text) & "' "
 List2.Clear
 Call Open_link
   Set RS = ZHCX.Execute(sql1, 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.Clone
   End If
 Call Close_link
   If List2.ListCount > 0 Then
      List2.ListIndex = 0
   Else
      A = MsgBox("设备类型记录为空", vbDefaultButton1)
   End If
   If Check1.Value Then
       sql2 = "select * from xdgl_bhdzbgb "
    Else
       If Check2.Value Then
           sql2 = "select * from xdgl_bhdzbgb where dwmc='" & Trim(List1.Text) & "'"
        Else
           If Check3.Value Then
               sql2 = "select * from xdgl_bhdzbgb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "'"
            Else
               sql2 = "select * from xdgl_bhdzbgb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "' and sbbh='" & Trim(List3.Text) & "'"
            End If
        End If
    End If
    Adodc1.RecordSource = sql2
    Adodc1.Refresh
    DataGrid1.Refresh
    Call sx
    End Sub

Private Sub List2_Click()
    sql3 = "select distinct sbmc from xdgl_sb_sbcsb where sbdl='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "'"
    List3.Clear
    Call Open_link
     Set RS = ZHCX.Execute(sql3, 0)
         Do While Not RS.EOF
           If Not IsNull(RS(0)) Then
               List3.AddItem RS(0)
            End If
            RS.MoveNext
          Loop
          If RS.State Then
             RS.Close
          End If
      If List3.ListCount > 0 Then
          List3.ListIndex = 0
      End If
      If Check1.Value Then
       sql2 = "select * from xdgl_bhdzbgb "
    Else
       If Check2.Value Then
           sql2 = "select * from xdgl_bhdzbgb where dwmc='" & Trim(List1.Text) & "'"
       Else
           If Check3.Value Then
               sql2 = "select * from xdgl_bhdzbgb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "'"
            Else
               sql2 = "select * from xdgl_bhdzbgb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "' and sbbh='" & Trim(List3.Text) & "'"
            End If
        End If
    End If
    Adodc1.RecordSource = sql2
    Adodc1.Refresh
    DataGrid1.Refresh
    Call Close_link
    Call sx
End Sub

Private Sub List3_Click()
  If Check1.Value Then
       sql2 = "select * from xdgl_bhdzbgb "
    Else
       If Check2.Value Then
           sql2 = "select * from xdgl_bhdzbgb where dwmc='" & Trim(List1.Text) & "'"
       Else
           If Check3.Value Then
               sql2 = "select * from xdgl_bhdzbgb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "'"
            Else
               sql2 = "select * from xdgl_bhdzbgb where dwmc='" & Trim(List1.Text) & "' and sbxl='" & Trim(List2.Text) & "' and sbbh='" & Trim(List3.Text) & "'"
            End If
        End If
    End If
    Adodc1.RecordSource = sql2
    Adodc1.Refresh
    DataGrid1.Refresh
  Call sx
End Sub