📄 frmfttzb.frm

📁 县级电力调度管理信息系统。VB6.0开发。 DMIS调度子系统包括以下功能模块：调度操作票管理、调度运行日志、调度交接班管理、调度值班管理、调度报表管理、调度文档、避峰拉闸限电管理等7个业务模块。
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
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(1).Value = Trim(List1.Text)
DataGrid1.Columns(2).Value = Trim(List2.Text)
DataGrid1.Columns(5).Value = Format(DTPicker1.Value, "yyyy-mm-dd") + " " + Format(Now, "hh:mm")
'Adodc1.Recordset.Update
'Adodc1.Refresh
Call Open_link
    sql2 = "select max(id) from xdgl_zbfjttzb"
  Set RS = ZHCX.Execute(sql2, 0)
     If Not IsNull(RS(0)) Then
        ID = 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 List1_Click
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
 Else
  Exit Sub
 End If
     Adodc1.Recordset.Update
     Adodc1.Refresh
     DataGrid1.Refresh
Call sx
End Sub

Private Sub Command3_Click(Index As Integer)
If Check1.Value Then
    sql1 = "select * from xdgl_zbfjttzb where tzsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tzsj"
  Else
       If Check2.Value Then
           sql1 = "select * from xdgl_zbfjttzb where bdz='" & Trim(List1.Text) & "'and tzsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tzsj"
       Else
           sql1 = "select * from xdgl_zbfjttzb where bdz='" & Trim(List1.Text) & "' and zb='" & 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()
     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, 8).Value = "TY-SJ-179"
           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.Columns("A:A").ColumnWidth = 8
           sendexcel.Columns("B:B").ColumnWidth = 8
           sendexcel.Columns("C:C").ColumnWidth = 7
           sendexcel.Columns("D:D").ColumnWidth = 7
           sendexcel.Columns("E:E").ColumnWidth = 16
           sendexcel.Columns("F:F").ColumnWidth = 7
           sendexcel.Columns("G:G").ColumnWidth = 7
           sendexcel.Columns("H:H").ColumnWidth = 12
           
       
    sendexcel.ActiveWindow.SmallScroll ToRight:=1
    sendexcel.ActiveWindow.SmallScroll ToRight:=-1
    sendexcel.Range("A2:H2").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:H").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("zb")))
                End If
                
                If IsNull(RS(3)) Then
                    sendexcel.Cells(j, 3).Value = ""
                Else
                    sendexcel.Cells(j, 3).Value = CStr(Trim(RS("tzqgyc")))
                End If
                
                If IsNull(RS(4)) Then
                    sendexcel.Cells(j, 4).Value = ""
                Else
                    sendexcel.Cells(j, 4).Value = CStr(Trim(RS("tzqzyc")))
                End If
                If IsNull(RS(5)) Then
                    sendexcel.Cells(j, 5).Value = ""
                Else
                    sendexcel.Cells(j, 5).Value = CStr(Trim(RS("tzsj")))
                End If
                If IsNull(RS(6)) Then
                    sendexcel.Cells(j, 6).Value = ""
                Else
                    sendexcel.Cells(j, 6).Value = CStr(Trim(RS("tzhgyc")))
                End If
                If IsNull(RS(7)) Then
                    sendexcel.Cells(j, 7).Value = ""
                Else
                    sendexcel.Cells(j, 7).Value = CStr(Trim(RS("tzhzyc")))
                End If
                If IsNull(RS(9)) Then
                    sendexcel.Cells(j, 8).Value = ""
                Else
                    sendexcel.Cells(j, 8).Value = CStr(Trim(RS("tzr")))
                End If
            RS.MoveNext
            j = j + 1
       Loop
   s_a = "A2:h" & 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:G1").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("H1").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))

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
 Call Close_link
 If List1.ListCount > 0 Then
   List1.ListIndex = 0
 Else
   A = MsgBox("厂站数据没有录入", vbDefaultButton2)
 End If
Adodc1.Refresh
DataGrid1.Refresh
Call sx
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
  Call Close_link
  If List2.ListCount <> 0 Then
  List2.ListIndex = 0
  End If
  If Check1.Value Then
    Adodc1.RecordSource = "select * from xdgl_zbfjttzb where tzsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tzsj"
  Else
     If Check2.Value Then
         Adodc1.RecordSource = "select * from xdgl_zbfjttzb where bdz='" & Trim(List1.Text) & "' and tzsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tzsj"
     Else
         Adodc1.RecordSource = "select * from xdgl_zbfjttzb where bdz='" & Trim(List1.Text) & "' and zb='" & Trim(List2.Text) & "' and tzsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tzsj"
     End If
  End If
  Adodc1.Refresh
  DataGrid1.Refresh

  Call sx
  
End Sub
Sub sx()
DataGrid1.Columns(0).Caption = "序号"
DataGrid1.Columns(0).Width = 500
DataGrid1.Columns(1).Caption = "变电站"
DataGrid1.Columns(1).Width = 750
DataGrid1.Columns(2).Caption = "主变"
DataGrid1.Columns(2).Width = 600
DataGrid1.Columns(3).Caption = "调前挡位高压侧"
DataGrid1.Columns(4).Caption = "调前挡位低压侧"
DataGrid1.Columns(5).Caption = "调整时间"
DataGrid1.Columns(6).Caption = "调后挡位高压侧"
DataGrid1.Columns(7).Caption = "调后挡位低压侧"
DataGrid1.Columns(8).Visible = False
DataGrid1.Columns(9).Caption = "调整人"
End Sub

Private Sub List2_Click()
  If Check1.Value Then
  Adodc1.RecordSource = "select * from xdgl_zbfjttzb where tzsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tzsj"
  Else
  Adodc1.RecordSource = "select * from xdgl_zbfjttzb where bdz='" & Trim(List1.Text) & "' and zb='" & Trim(List2.Text) & "' and tzsj BETWEEN '" & DTPicker1.Value & "' and '" & DTPicker2.Value & "' order by tzsj"
  End If
  Adodc1.Refresh
  DataGrid1.Refresh
  Call sx
End Sub
上一页 12
💿 文件大小 418 K
👤 上传用户 liu2000dz
📂 所属分类企业管理
🏷️ 相关标签

#调度 #DMIS #6.0 #模块
⌨️ 快捷键说明

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