⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frm电量平衡.frm

📁 县级电力调度管理信息系统。VB6.0开发。 DMIS调度子系统包括以下功能模块:调度操作票管理、调度运行日志、调度交接班管理、调度值班管理、调度报表管理、调度文档、避峰拉闸限电管理等7个业务模块。
💻 FRM
📖 第 1 页 / 共 5 页
字号:
    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()
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
End Sub

Private Sub Command4_Click()
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 DataGrid1_Click()
If Adodc1.Recordset.EOF Then
 Else
    Adodc1.Recordset.Update
    Call sx
 End If
End Sub



Private Sub DTPicker1_Change()
Adodc1.RecordSource = "select * from xdgl_dlph where rq='" & DTPicker1.Value & "' and bdz='" & Trim(Combo2.Text) & "'"
Adodc1.Refresh
Call sx
Call qk
End Sub

Private Sub DTPicker1_Click()
Adodc1.RecordSource = "select * from xdgl_dlph where rq='" & DTPicker1.Value & "' and bdz='" & Trim(Combo2.Text) & "'"
Adodc1.Refresh
Call sx
End Sub

Private Sub Form_Load()
On Error Resume Next
DTPicker1.Value = Format(Now, "yyyy-mm-01")
Adodc1.ConnectionString = "PROVIDER=MSDASQL;dsn=ddmis;uid=mis;pwd=mis005;database=zhcx"
Adodc1.RecordSource = "select * from xdgl_dlph where rq='" & DTPicker1.Value & "' and bdz='" & Trim(Combo2.Text) & "'"
Combo3.Clear
Combo3.AddItem "110kV"
Combo3.AddItem "35kV"
Combo3.AddItem "10kV"
Combo3.ListIndex = 1
sql1 = "select distinct BDZ from xdgl_jld where dydj='110kV'"
   Call Open_link
   Combo2.Clear
   Set RS = ZHCX.Execute(sql1, 0)
       Do While Not RS.EOF
         If Not IsNull(RS(0)) Then
            Combo2.AddItem Trim(RS(0))
         End If
         RS.MoveNext
       Loop
       If RS.State Then
          RS.Close
       End If
   Combo1.Clear
   Set RS = ZHCX.Execute(sql1, 0)
       Do While Not RS.EOF
         If Not IsNull(RS(0)) Then
            Combo1.AddItem Trim(RS(0))
         End If
         RS.MoveNext
       Loop
       If RS.State Then
          RS.Close
       End If
       
Call Close_link
If Combo2.ListCount > 0 Then
    Combo2.ListIndex = 1
End If
If Combo1.ListCount > 0 Then
    Combo1.ListIndex = 1
End If
Adodc1.Refresh
Call sx
End Sub

Sub sx()
DataGrid1.Columns(0).Visible = False
DataGrid1.Columns(1).Caption = "   计量关口"
DataGrid1.Columns(1).Width = 1200
DataGrid1.Columns(2).Visible = False
DataGrid1.Columns(3).Caption = "  电量类型"
DataGrid1.Columns(3).Width = 1200
DataGrid1.Columns(4).Caption = "   尖"
DataGrid1.Columns(4).Width = 800
DataGrid1.Columns(5).Caption = "   峰"
DataGrid1.Columns(5).Width = 800
DataGrid1.Columns(6).Caption = "   平"
DataGrid1.Columns(6).Width = 800
DataGrid1.Columns(7).Caption = "   谷"
DataGrid1.Columns(7).Width = 800
DataGrid1.Columns(8).Caption = "   总"
DataGrid1.Columns(8).Width = 800
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If Index = 0 Then
        If KeyCode = 13 Then
            Text2.SetFocus
        Else
        End If
    Else
    End If
End Sub

Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If Index = 0 Then
        If KeyCode = 13 Then
            Text3.SetFocus
        Else
        End If
    Else
    End If
End Sub
Private Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)
If Index = 0 Then
        If KeyCode = 13 Then
            Text4.SetFocus
        Else
        End If
    Else
    End If
End Sub
Private Sub Text4_KeyDown(KeyCode As Integer, Shift As Integer)
If Index = 0 Then
        If KeyCode = 13 Then
            Text5.SetFocus
        Else
        End If
    Else
    End If
End Sub
Private Sub Text5_KeyDown(KeyCode As Integer, Shift As Integer)
If Index = 0 Then
        If KeyCode = 13 Then
            Text10.SetFocus
        Else
        End If
    Else
    End If
End Sub
Private Sub Text10_KeyDown(KeyCode As Integer, Shift As Integer)
If Index = 0 Then
        If KeyCode = 13 Then
            Text9.SetFocus
        Else
        End If
    Else
    End If
End Sub

Private Sub Text9_KeyDown(KeyCode As Integer, Shift As Integer)
If Index = 0 Then
        If KeyCode = 13 Then
            Text8.SetFocus
        Else
        End If
    Else
    End If
End Sub
Private Sub Text8_KeyDown(KeyCode As Integer, Shift As Integer)
If Index = 0 Then
        If KeyCode = 13 Then
            Text7.SetFocus
        Else
        End If
    Else
    End If
End Sub
Private Sub Text7_KeyDown(KeyCode As Integer, Shift As Integer)
If Index = 0 Then
        If KeyCode = 13 Then
            Text6.SetFocus
        Else
        End If
    Else
    End If
End Sub
Private Sub Text6_KeyDown(KeyCode As Integer, Shift As Integer)
If Index = 0 Then
        If KeyCode = 13 Then
            Command1.SetFocus
        Else
        End If
    Else
    End If
End Sub


Private Sub Text1_LostFocus()
On Error Resume Next
Text5.Text = CDbl(Text1.Text) + CDbl(Text2.Text) + CDbl(Text3.Text) + CDbl(Text4.Text)
End Sub

Private Sub Text2_LostFocus()
On Error Resume Next
Text5.Text = CDbl(Text1.Text) + CDbl(Text2.Text) + CDbl(Text3.Text) + CDbl(Text4.Text)

End Sub
Private Sub Text3_LostFocus()
On Error Resume Next
Text5.Text = CDbl(Text1.Text) + CDbl(Text2.Text) + CDbl(Text3.Text) + CDbl(Text4.Text)

End Sub
Private Sub Text4_LostFocus()
On Error Resume Next
Text5.Text = CDbl(Text1.Text) + CDbl(Text2.Text) + CDbl(Text3.Text) + CDbl(Text4.Text)

End Sub

Private Sub Text10_LostFocus()
On Error Resume Next
Text6.Text = CDbl(Text10.Text) + CDbl(Text9.Text) + CDbl(Text8.Text) + CDbl(Text7.Text)
End Sub

Private Sub Text9_LostFocus()
On Error Resume Next
Text6.Text = CDbl(Text10.Text) + CDbl(Text9.Text) + CDbl(Text8.Text) + CDbl(Text7.Text)

End Sub
Private Sub Text8_LostFocus()
On Error Resume Next
Text6.Text = CDbl(Text10.Text) + CDbl(Text9.Text) + CDbl(Text8.Text) + CDbl(Text7.Text)

End Sub
Private Sub Text7_LostFocus()
On Error Resume Next
Text6.Text = CDbl(Text10.Text) + CDbl(Text9.Text) + CDbl(Text8.Text) + CDbl(Text7.Text)

End Sub


Sub qk()
Text1.Text = ""
Text2.Text = ""
Text3.Text = ""
Text4.Text = ""
Text5.Text = ""
Text6.Text = ""
Text7.Text = ""
Text8.Text = ""
Text9.Text = ""
Text10.Text = ""


End Sub

⌨️ 快捷键说明

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