frm关口电量.frm

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

    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
Call Close_link

End Sub

Private Sub Command3_Click()
On Error Resume Next
Call MsgBox("请确定所有关口的起码和止码已经填写")
Call Open_link
sql1 = "select * from xdgl_jsb where type='关口'"
   If RS.State Then
      RS.Close
  End If
   Set RS = ZHCX.Execute(sql1, 0)
       Do While Not RS.EOF
         If Not IsNull(RS(0)) Then
            sql1 = "select * from xdgl_ddyb_rdl where rq='" & DTPicker1.Value & "' and gk='" & Trim(RS("jlgk")) & "' and dllx='止码'"
            If RS1.State Then
               RS1.Close
            End If
            Set RS1 = ZHCX.Execute(sql1, 1)
            sql2 = "select * from xdgl_ddyb_rdl where rq='" & DTPicker1.Value & "' and gk='" & Trim(RS("jlgk")) & "' and dllx='起码'"
            If RS2.State Then
               RS2.Close
            End If
            Set RS2 = ZHCX.Execute(sql2, 1)
            If RS1.EOF Then
               Call MsgBox("请输入" & RS("jlgk") & "止码")
            End If
            If RS2.EOF Then
               Call MsgBox("请输入" & RS("jlgk") & "起码")
            End If

            If (Not RS1.EOF) And (Not RS2.EOF) Then
                  sql3 = "select * from xdgl_ddyb_rdl where rq='" & DTPicker1.Value & "' and gk='" & Trim(RS("jlgk")) & "' and dllx='表码'"
                  Set RS3 = ZHCX.Execute(sql3, 0)
                  If RS3.EOF Then
                        sql3 = "insert xdgl_ddyb_rdl (rq,dllx,gk,d_1,d_2,d_3,d_4,d_z) values('" & DTPicker1.Value & "','表码','" & Trim(RS("jlgk")) & "'," & Format(CDbl(RS1("d_1")) - CDbl(RS2("d_1")), "0.00") & "," & Format(CDbl(RS1("d_2")) - CDbl(RS2("d_2")), "0.00") & "," & Format(CDbl(RS1("d_3")) - CDbl(RS2("d_3")), "0.00") & "," & Format(CDbl(RS1("d_4")) - CDbl(RS2("d_4")), "0.00") & "," & Format(CDbl(RS1("d_z")) - CDbl(RS2("d_z")), "0.00") & ")"
                  Else
                        sql3 = "update xdgl_ddyb_rdl set d_1=" & Format(CDbl(RS1("d_1")) - CDbl(RS2("d_1")), "0.00") & ",d_2=" & Format(CDbl(RS1("d_2")) - CDbl(RS2("d_2")), "0.00") & ",d_3=" & Format(CDbl(RS1("d_3")) - CDbl(RS2("d_3")), "0.00") & ",d_4=" & Format(CDbl(RS1("d_4")) - CDbl(RS2("d_4")), "0.00") & ",d_z=" & Format(CDbl(RS1("d_z")) - CDbl(RS2("d_z")), "0.00") & " where rq='" & DTPicker1.Value & "' and gk='" & Trim(RS("jlgk")) & "' and dllx='表码'"
                  End If
                  If RS3.State Then
                     RS3.Close
                  End If
                  Set RS3 = ZHCX.Execute(sql3, 1)
                  If RS3.State Then
                     RS3.Close
                  End If
            End If
         End If
         RS.MoveNext
       Loop
       If RS.State Then
          RS.Close
       End If
Call MsgBox("计算表码完成!")
Call Close_link
Adodc1.Refresh

Call sx

Call MsgBox("请确定已经计算了表码")
Call Open_link
sql1 = "select * from xdgl_jsb where type='关口'"
   If RS.State Then
      RS.Close
    End If
   Set RS = ZHCX.Execute(sql1, 0)
       Do While Not RS.EOF
         If Not IsNull(RS(0)) Then
            sql1 = "select * from xdgl_ddyb_rdl where rq='" & DTPicker1.Value & "' and gk='" & Trim(RS("jlgk")) & "' and dllx='表码'"
            If RS1.State Then
               RS1.Close
            End If
            Set RS1 = ZHCX.Execute(sql1, 1)
            If RS1.EOF Then
               Call MsgBox("请计算" & RS("jlgk") & "表码")
            End If

            If (Not RS1.EOF) Then
                  sql3 = "select * from xdgl_ddyb_rdl where rq='" & DTPicker1.Value & "' and gk='" & Trim(RS("jlgk")) & "' and dllx='表码'"
                  Set RS3 = ZHCX.Execute(sql3, 0)
                  If RS3.EOF Then
                        sql3 = "insert xdgl_ddyb_rdl (rq,dllx,gk,d_1,d_2,d_3,d_4,d_z) values('" & DTPicker1.Value & "','电量','" & Trim(RS("jlgk")) & "'," & Format(CDbl(RS1("d_1")) * CDbl(RS("bl")), "0.00") & "," & Format(CDbl(RS1("d_2")) * CDbl(RS("bl")), "0.00") & "," & Format(CDbl(RS1("d_3")) * CDbl(RS("bl")), "0.00") & "," & Format(CDbl(RS1("d_4")) * CDbl(RS("bl")), "0.00") & "," & Format(CDbl(RS1("d_z")) * CDbl(RS("bl")), "0.00") & ")"
                  Else
                        sql3 = "update xdgl_ddyb_rdl set d_1=" & Format(CDbl(RS1("d_1")) * CDbl(RS("bl")), "0.00") & ",d_2=" & Format(CDbl(RS1("d_2")) * CDbl(RS("bl")), "0.00") & ",d_3=" & Format(CDbl(RS1("d_3")) * CDbl(RS("bl")), "0.00") & ",d_4=" & Format(CDbl(RS1("d_4")) * CDbl(RS("bl")), "0.00") & ",d_z=" & Format(CDbl(RS1("d_z")) * CDbl(RS("bl")), "0.00") & " where rq='" & DTPicker1.Value & "' and gk='" & Trim(RS("jlgk")) & "' and dllx='电量'"
                  End If
                  If RS3.State Then
                     RS3.Close
                  End If
                  Set RS3 = ZHCX.Execute(sql3, 1)
                  If RS3.State Then
                     RS3.Close
                  End If
            End If
         End If
         RS.MoveNext
       Loop
       If RS.State Then
          RS.Close
       End If
Call MsgBox("计算电量完成!")
Call Close_link
Adodc1.Refresh
Call sx
End Sub


Private Sub Command4_Click()
On Error Resume Next
Dim b(3) As String
Dim sendexcel As Excel.Application
Set sendexcel = CreateObject("Excel.Application")
    sendexcel.Visible = True
    sendexcel.Workbooks.Add
Call Open_link


  

sendexcel.Range("A1:W1").Select
    sendexcel.ActiveWindow.ScrollColumn = 1
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    sendexcel.Selection.Merge
    sendexcel.ActiveWindow.ScrollColumn = 4
    sendexcel.ActiveWindow.ScrollColumn = 12
    sendexcel.ActiveWindow.ScrollColumn = 14
    sendexcel.ActiveWindow.ScrollColumn = 1
    sendexcel.Rows("1:1").RowHeight = 22.5
    sendexcel.Rows("1:1").RowHeight = 29.25
    sendexcel.Range("A1:W1").Select
    With sendexcel.Selection.Font
        .Name = "宋体"
        .Size = 24
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With sendexcel.Selection.Font
        .Name = "隶书"
        .Size = 24
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    sendexcel.ActiveWindow.ScrollColumn = 7
    sendexcel.ActiveWindow.ScrollColumn = 1
    sendexcel.Rows("1:1").RowHeight = 34.5
    sendexcel.ActiveWindow.ScrollColumn = 6
    sendexcel.ActiveWindow.ScrollColumn = 1
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
    sendexcel.ActiveWindow.ScrollColumn = 10
    sendexcel.ActiveWindow.ScrollColumn = 6
    sendexcel.ActiveWindow.ScrollColumn = 14
    sendexcel.Range("U2:W2").Select
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    sendexcel.Selection.Merge
    sendexcel.Range("U2:W2").Select
    sendexcel.ActiveCell.FormulaR1C1 = "制表人：                    计量单位：万kwh"
    With sendexcel.ActiveCell.Characters(Start:=1, Length:=6).Font
        .Name = "宋体"
        .FontStyle = "常规"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    With sendexcel.ActiveCell.Characters(Start:=7, Length:=3).Font
        .Name = "Times New Roman"
        .FontStyle = "常规"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
    sendexcel.Range("U2:W2").Select
    sendexcel.Rows("2:2").RowHeight = 18
    sendexcel.ActiveWindow.ScrollColumn = 1
    sendexcel.Range("A3:A4").Select
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    sendexcel.Selection.Merge
    sendexcel.Range("B3:B4").Select
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    sendexcel.Selection.Merge
    sendexcel.Range("A3:A4").Select
    sendexcel.ActiveCell.FormulaR1C1 = "计量关口"
    sendexcel.Range("B3:B4").Select
    sendexcel.ActiveCell.FormulaR1C1 = "计量方法"
    sendexcel.Range("C3:G3").Select
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    sendexcel.Selection.Merge
    sendexcel.ActiveCell.FormulaR1C1 = "止步码"
    sendexcel.Range("C3:G3").Select
    sendexcel.ActiveCell.FormulaR1C1 = "止码"
    sendexcel.Range("C4").Select
    sendexcel.ActiveCell.FormulaR1C1 = "尖"
    sendexcel.Range("D4").Select
    sendexcel.ActiveCell.FormulaR1C1 = "峰"
    sendexcel.Range("E4").Select
    sendexcel.ActiveCell.FormulaR1C1 = "平"
    sendexcel.Range("F4").Select
    sendexcel.ActiveCell.FormulaR1C1 = "谷"
    sendexcel.Range("G4").Select
    sendexcel.ActiveCell.FormulaR1C1 = "总"
    sendexcel.Range("H3").Select
    sendexcel.ActiveWindow.ScrollColumn = 5
    sendexcel.Range("H3:L3").Select
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    sendexcel.Selection.Merge
    sendexcel.ActiveCell.FormulaR1C1 = "起码"
    sendexcel.Range("C4:G4").Select
    sendexcel.Selection.Copy
    sendexcel.Range("H4:L4").Select
    sendexcel.ActiveSheet.Paste
    sendexcel.ActiveWindow.ScrollColumn = 8
    sendexcel.Range("M3:Q3").Select
    sendexcel.Application.CutCopyMode = False
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    sendexcel.Selection.Merge
    sendexcel.ActiveCell.FormulaR1C1 = "表码"
    sendexcel.Range("H4:L4").Select
    sendexcel.Selection.Copy
    sendexcel.Range("M4:Q4").Select
    sendexcel.ActiveSheet.Paste
    sendexcel.ActiveWindow.ScrollColumn = 12
    sendexcel.Range("S3:W3").Select
    sendexcel.Application.CutCopyMode = False
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    sendexcel.Selection.Merge
    sendexcel.Range("S4").Select
    sendexcel.ActiveWindow.SmallScroll ToRight:=-3
    sendexcel.Range("M4:Q4").Select
    sendexcel.Selection.Copy
    sendexcel.ActiveWindow.ScrollColumn = 14
    sendexcel.Range("S4:W4").Select
    sendexcel.ActiveSheet.Paste
    sendexcel.Range("R3:R4").Select
    sendexcel.Application.CutCopyMode = False
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    sendexcel.Selection.Merge
    sendexcel.ActiveCell.FormulaR1C1 = "倍率"
    sendexcel.Range("S11").Select
    sendexcel.ActiveWindow.ScrollColumn = 1
    sendexcel.Rows("2:4").Select
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter