📄 frm电量平衡.frm
字号:
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 + -