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

📄 frm主要经济技术指标.frm

📁 县级电力调度管理信息系统。VB6.0开发。 DMIS调度子系统包括以下功能模块：调度操作票管理、调度运行日志、调度交接班管理、调度值班管理、调度报表管理、调度文档、避峰拉闸限电管理等7个业务模块。
💻 FRM
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
   End
End
Attribute VB_Name = "frm主要经济技术指标"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
On Error Resume Next
 If Text1.Text = "" Or Text2.Text = "" Or Text3.Text = "" Or Text4.Text = "" Or Text5.Text = "" Or Text6.Text = "" Then
   A = MsgBox("请完整填写数据", vbOKOnly, "错误")
  Exit Sub
 End If
 
 If IsNumeric(Text1.Text) And IsNumeric(Text2.Text) And IsNumeric(Text3.Text) And IsNumeric(Text4.Text) Then
 Else
 A = MsgBox("数据输入有问题，请检查输入！", vbOKOnly, "错误")
 Exit Sub
 End If
 
 Call Open_link
  sql1 = "select * from xdgl_ddyb_scrw where rq='" & DTPicker1.Value & "' "
  Set RS = ZHCX.Execute(sql1, 0)
   If RS.EOF Then
      sql1 = "insert xdgl_ddyb_scrw (rq,gdl,wsl,zgfh,zdfh,zgfh_cxsj,zdfh_cxsj) values('" & DTPicker1.Value & "','" & Trim(Text1.Text) & "','" & Trim(Text2.Text) & "'," & Trim(Text3.Text) & "," & Trim(Text4.Text) & ",'" & DTPicker2.Value & "','" & DTPicker2.Value & "')"
   Else
      sql1 = "update xdgl_ddyb_scrw set gdl=" & Text1.Text & ",wsl=" & Text2.Text & ",zgfh=" & Text3.Text & ",zdfh=" & Text4.Text & ",zgfh_cxsj='" & DTPicker2.Value & "',zdfh_cxsj='" & DTPicker3.Value & "' where rq='" & DTPicker1.Value & "' "
   End If
   If RS.State Then
       RS.Close
   End If
    Set RS = ZHCX.Execute(sql1, 0)
    
    If RS.State Then
       RS.Close
    End If
  
  Call Close_link

End Sub

Private Sub Command10_Click()
On Error Resume Next
  Dim sendexcel As Excel.Application
Call Open_link

Set sendexcel = CreateObject("excel.Application")
 sendexcel.Visible = True
sendexcel.Workbooks.Open (App.Path + "\调度月报.xls")  ' 打开EXCEL工作簿
sendexcel.Visible = True
sendexcel.Caption = "经济技术指标" ' 指定标题栏名称
sendexcel.Sheets("经济技术指标").Select
sendexcel.Sheets("经济技术指标").Visible = True
sendexcel.Sheets("经济技术指标").Cells(1, 1).Value = "元月至本月主要技术经济指标"
ys = DateDiff("m", DTPicker1.Value, Format(DTPicker1.Value, "yyyy-01-01"))
   sql1 = "select sum(gdl),sum(wsl) from xdgl_ddyb_scrw where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "'"
   sql2 = "select max(zgfh) from xdgl_ddyb_scrw where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "'"
   sql3 = "select min(zdfh) from xdgl_ddyb_scrw where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "'"
   Set RS = ZHCX.Execute(sql1, 1)
   sendexcel.Sheets("经济技术指标").Cells(4, 2).Value = RS(0)
   sendexcel.Sheets("经济技术指标").Cells(4, 5).Value = Format(CDbl(RS(1)) / ys, "0.00")
   If RS.State Then
       RS.Close
   End If
   Set RS = ZHCX.Execute(sql2, 1)
   sendexcel.Sheets("经济技术指标").Cells(2, 9).Value = RS(0)
      If Not IsNull(RS(0)) Then
      
        sql2 = "select zgfh_cxsj from xdgl_ddyb_scrw where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "' and zgfh=" & RS(0)
        Set RS1 = ZHCX.Execute(sql2, 1)
        sendexcel.Sheets("经济技术指标").Range("M2:O3").FormulaR1C1 = Format(RS(0), "mm月dd日")
        RS1.Close
      End If
   If RS.State Then
       RS.Close
   End If
   Set RS = ZHCX.Execute(sql3, 1)
   sendexcel.Sheets("经济技术指标").Cells(4, 9).Value = RS(0)
        If Not IsNull(RS(0)) Then
            sql2 = "select zdfh_cxsj from xdgl_ddyb_scrw where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "' and zdfh=" & RS(0)
            Set RS1 = ZHCX.Execute(sql2, 1)
            sendexcel.Sheets("经济技术指标").Range("M4:O5").FormulaR1C1 = Format(RS(1), "mm月dd日")
            RS1.Close
        End If
   If RS.State Then
       RS.Close
   End If
  
   sql3 = "select min(zdfh) from xdgl_ddyb_scrw where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "'"
  
  
 sql1 = "select * from xdgl_ddyb_mnsckh where rq='" & DTPicker1.Value & "' "
 Set RS = ZHCX.Execute(sql1, 1)
 If Not RS.EOF Then
   sendexcel.Sheets("经济技术指标").Cells(10, 5).Value = RS("jfdl")
 End If
  If RS.State Then
    RS.Close
  End If
sql1 = "select sum(d_j),sum(d_f),sum(d_p),sum(d_g),sum(d_z),avg(yjhgl) from xdgl_ddyb_mnsckh where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "'"
 Set RS = ZHCX.Execute(sql1, 1)
   sendexcel.Sheets("经济技术指标").Cells(8, 2).Value = RS(0)
   sendexcel.Sheets("经济技术指标").Cells(8, 5).Value = RS(1)
   sendexcel.Sheets("经济技术指标").Cells(8, 8).Value = RS(2)
   sendexcel.Sheets("经济技术指标").Cells(8, 11).Value = RS(3)
   sendexcel.Sheets("经济技术指标").Cells(8, 13).Value = RS(4)
   sendexcel.Sheets("经济技术指标").Cells(10, 11).Value = RS(5)
If RS.State Then
   RS.Close
End If

sql1 = "select * from xdgl_ddyb_aqsc where rq='" & DTPicker1.Value & "' "
Set RS = ZHCX.Execute(sql1, 1)
If Not RS.EOF Then
   sendexcel.Sheets("经济技术指标").Cells(14, 2).Value = RS("aqyxjl")
End If

 sql1 = "select sum(jtzlp),sum(zhzlp),sum(hj),avg(hgl) from xdgl_ddyb_aqsc where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "'"
 Set RS = ZHCX.Execute(sql1, 1)
   sendexcel.Sheets("经济技术指标").Cells(15, 7).Value = RS(0)
   sendexcel.Sheets("经济技术指标").Cells(15, 9).Value = RS(1)
   sendexcel.Sheets("经济技术指标").Cells(15, 11).Value = RS(2)
   sendexcel.Sheets("经济技术指标").Cells(15, 13).Value = RS(3)
  If RS.State Then
     RS.Close
  End If
  
 sql1 = "select avg(ydzcyxl),avg(zyyclhgl) from xdgl_ddyb_ydqk where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "'"
 Set RS = ZHCX.Execute(sql1, 1)
 sendexcel.Sheets("经济技术指标").Cells(17, 12).Value = RS(0)
 sendexcel.Sheets("经济技术指标").Cells(19, 12).Value = RS(1)
  If RS.State Then
     RS.Close
  End If
  

'   Case "光纤"
 sql1 = "select sum(khsl),sum(gzsj),sum(pjgzsj),avg(yxl) from xdgl_ddyb_txyx where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "' and mc='光纤'"
 Set RS = ZHCX.Execute(sql1, 1)
        
        sendexcel.Sheets("经济技术指标").Cells(17, 4).Value = RS(0)
        sendexcel.Sheets("经济技术指标").Cells(17, 7).Value = RS(1)
        sendexcel.Sheets("经济技术指标").Cells(17, 10).Value = RS(2)
        sendexcel.Sheets("经济技术指标").Cells(17, 13).Value = RS(3)

  If RS.State Then
     RS.Close
  End If
'   Case "载波"
 sql1 = "select sum(khsl),sum(gzsj),sum(pjgzsj),avg(yxl) from xdgl_ddyb_txyx where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "' and mc='载波'"
 Set RS = ZHCX.Execute(sql1, 1)
        sendexcel.Sheets("经济技术指标").Cells(18, 4).Value = RS(0)
        sendexcel.Sheets("经济技术指标").Cells(18, 7).Value = RS(1)
        sendexcel.Sheets("经济技术指标").Cells(18, 10).Value = RS(2)
        sendexcel.Sheets("经济技术指标").Cells(18, 13).Value = RS(3)
 
  If RS.State Then
     RS.Close
  End If
'  Case "总机"
sql1 = "select sum(khsl),sum(gzsj),sum(pjgzsj),avg(yxl) from xdgl_ddyb_txyx where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "' and mc='总机'"
 Set RS = ZHCX.Execute(sql1, 1)
        sendexcel.Sheets("经济技术指标").Cells(19, 4).Value = RS(0)
        sendexcel.Sheets("经济技术指标").Cells(19, 7).Value = RS(1)
        sendexcel.Sheets("经济技术指标").Cells(19, 10).Value = RS(2)
        sendexcel.Sheets("经济技术指标").Cells(19, 13).Value = RS(3)
  
  If RS.State Then
     RS.Close
  End If
'  Case "微波"
sql1 = "select sum(khsl),sum(gzsj),sum(pjgzsj),avg(yxl) from xdgl_ddyb_txyx where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "' and mc='微波'"
 Set RS = ZHCX.Execute(sql1, 1)
        sendexcel.Sheets("经济技术指标").Cells(20, 4).Value = RS(0)
        sendexcel.Sheets("经济技术指标").Cells(20, 7).Value = RS(1)
        sendexcel.Sheets("经济技术指标").Cells(20, 10).Value = RS(2)
        sendexcel.Sheets("经济技术指标").Cells(20, 13).Value = RS(3)

  If RS.State Then
     RS.Close
  End If
  
 sql1 = "select dydj,sum(zsl),sum(zqcs),sum(zchcg),sum(zchbcg) from xdgl_ddyb_bhzz where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "' GROUP BY DYDJ"
 Set RS = ZHCX.Execute(sql1, 1)
 Do While Not RS.EOF
  Select Case Trim(RS("dydj"))
    Case "全部装置"
        sendexcel.Sheets("经济技术指标").Cells(22, 4).Value = RS(1)
        sendexcel.Sheets("经济技术指标").Cells(22, 7).Value = RS(2)
        sendexcel.Sheets("经济技术指标").Cells(22, 10).Value = RS(3)
        sendexcel.Sheets("经济技术指标").Cells(22, 13).Value = RS(4)
    Case "10kV"
        sendexcel.Sheets("经济技术指标").Cells(23, 4).Value = RS(1)
        sendexcel.Sheets("经济技术指标").Cells(23, 7).Value = RS(2)
        sendexcel.Sheets("经济技术指标").Cells(23, 10).Value = RS(3)
        sendexcel.Sheets("经济技术指标").Cells(23, 13).Value = RS(4)
    Case "35kV"
        sendexcel.Sheets("经济技术指标").Cells(24, 4).Value = RS(1)
        sendexcel.Sheets("经济技术指标").Cells(24, 7).Value = RS(2)
        sendexcel.Sheets("经济技术指标").Cells(24, 10).Value = RS(3)
        sendexcel.Sheets("经济技术指标").Cells(24, 13).Value = RS(4)
    Case "110kV"
        sendexcel.Sheets("经济技术指标").Cells(25, 4).Value = RS(1)
        sendexcel.Sheets("经济技术指标").Cells(25, 7).Value = RS(2)
        sendexcel.Sheets("经济技术指标").Cells(25, 10).Value = RS(3)
        sendexcel.Sheets("经济技术指标").Cells(25, 13).Value = RS(4)
    Case "故障录波"
        sendexcel.Sheets("经济技术指标").Cells(26, 4).Value = RS(1)
        sendexcel.Sheets("经济技术指标").Cells(26, 7).Value = RS(2)
        sendexcel.Sheets("经济技术指标").Cells(26, 10).Value = RS(3)
        sendexcel.Sheets("经济技术指标").Cells(26, 13).Value = RS(4)
  
  End Select
  RS.MoveNext

Loop
  If RS.State Then
     RS.Close
  End If
 
 sql1 = "select dw,sum(jh),sum(lj),sum(sg),sum(hj) from xdgl_ddyb_sbjx where rq between '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & DTPicker1.Value & "' GROUP BY dw"
 Set RS = ZHCX.Execute(sql1, 1)
 If RS.EOF Then
 Else
 i = 1
 j = 29
 Do While Not RS.EOF
        Select Case (i Mod 3)
        Case 1
            sendexcel.Sheets("经济技术指标").Cells(j, 1).Value = Trim(RS("dw"))
            sendexcel.Sheets("经济技术指标").Cells(j, 2).Value = RS(1)
            sendexcel.Sheets("经济技术指标").Cells(j, 3).Value = RS(2)
            sendexcel.Sheets("经济技术指标").Cells(j, 4).Value = RS(3)
            sendexcel.Sheets("经济技术指标").Cells(j, 5).Value = RS(4)
        Case 2
            sendexcel.Sheets("经济技术指标").Cells(j, 6).Value = Trim(RS("dw"))
            sendexcel.Sheets("经济技术指标").Cells(j, 7).Value = RS(1)
            sendexcel.Sheets("经济技术指标").Cells(j, 8).Value = RS(2)
            sendexcel.Sheets("经济技术指标").Cells(j, 9).Value = RS(3)
            sendexcel.Sheets("经济技术指标").Cells(j, 10).Value = RS(4)
        
        Case 0
            sendexcel.Sheets("经济技术指标").Cells(j, 11).Value = Trim(RS("dw"))
            sendexcel.Sheets("经济技术指标").Cells(j, 12).Value = RS(1)
            sendexcel.Sheets("经济技术指标").Cells(j, 13).Value = RS(2)
            sendexcel.Sheets("经济技术指标").Cells(j, 14).Value = RS(3)
            sendexcel.Sheets("经济技术指标").Cells(j, 15).Value = RS(4)
       End Select
       RS.MoveNext
       If (i Mod 3) = 0 Then
          j = j + 1
       End If
       i = i + 1
Loop
 End If
  If RS.State Then
     RS.Close
  End If
Call Close_link
If Err Then Err.Clear
End Sub

Private Sub Command2_Click()
On Error Resume Next
 If Text7.Text = "" Or Text8.Text = "" Or Text9.Text = "" Or Text10.Text = "" Or Text11.Text = "" Or Text13.Text = "" Then
   A = MsgBox("请完整填写数据", vbOKOnly, "错误")
  Exit Sub
 End If
 
 If IsNumeric(Text7.Text) And IsNumeric(Text8.Text) And IsNumeric(Text9.Text) And IsNumeric(Text10.Text) And IsNumeric(Text11.Text) And IsNumeric(Text12.Text) And IsNumeric(Text13.Text) Then
 Else
 A = MsgBox("数据输入有问题，请检查输入！", vbOKOnly, "错误")
 Exit Sub
 End If
 
 Call Open_link
  sql1 = "select * from xdgl_ddyb_mnsckh where rq='" & DTPicker1.Value & "' "
  Set RS = ZHCX.Execute(sql1, 0)
   If RS.EOF Then
      sql1 = "insert xdgl_ddyb_mnsckh (rq,d_j,d_f,d_p,d_g,d_z,jfdl,yjhgl) values('" & DTPicker1.Value & "','" & Trim(Text7.Text) & "','" & Trim(Text8.Text) & "'," & Trim(Text9.Text) & "," & Trim(Text10.Text) & "," & Trim(Text11.Text) & "," & Trim(Text12.Text) & "," & Trim(Text13.Text) & ")"
   Else
      sql1 = "update xdgl_ddyb_mnsckh set d_j=" & Text7.Text & ",d_f=" & Text8.Text & ",d_p=" & Text9.Text & ",d_g=" & Text10.Text & ",d_z=" & Text11.Text & ",jfdl=" & Text12.Text & ",yjhgl=" & Trim(Text13.Text) & " where rq='" & DTPicker1.Value & "' "
   End If
   If RS.State Then
       RS.Close
   End If
    Set RS = ZHCX.Execute(sql1, 0)
    
    If RS.State Then
       RS.Close
    End If
  
  Call Close_link

End Sub

Private Sub Command3_Click()
On Error Resume Next
 Call Open_link
  sql1 = "select count(zxlph) from xdgl_zxczpzb where zxqk='已执行' and zxsj between '" & DTPicker1.Value & "' and '" & DateAdd("d", -1, DateAdd("m", 1, DTPicker1.Value)) & "'"
  sql2 = "select count(zlph) from xdgl_zhczpzb where zxjg='已执行' and rq between '" & DTPicker1.Value & "' and '" & DateAdd("d", -1, DateAdd("m", 1, DTPicker1.Value)) & "'"
  sql3 = "select count(zxlph) from xdgl_zxczpzb where pjqk='合格' and zxsj between '" & DTPicker1.Value & "' and '" & DateAdd("d", -1, DateAdd("m", 1, DTPicker1.Value)) & "'"
  sql4 = "select count(zlph) from xdgl_zhczpzb where pjjg='已执行' and rq between '" & DTPicker1.Value & "' and '" & DateAdd("d", -1, DateAdd("m", 1, DTPicker1.Value)) & "'"
  
  Set RS = ZHCX.Execute(sql1, 0)
       If Not RS.EOF Then
         temp1 = RS(0)
       End If
       If RS.State Then
       RS.Close
       End If
  
  Set RS = ZHCX.Execute(sql2, 0)
       If Not RS.EOF Then
         temp2 = RS(0)
       End If
       If RS.State Then
       RS.Close
       End If
  
  Set RS = ZHCX.Execute(sql3, 0)
       If Not RS.EOF Then
         temp3 = RS(0)
       End If
       If RS.State Then
       RS.Close
       End If
  
  Set RS = ZHCX.Execute(sql4, 0)
       If Not RS.EOF Then
         temp4 = RS(0)
       End If
       If RS.State Then
       RS.Close
       End If

Text15.Text = temp1
Text16.Text = temp2
Text17.Text = temp1 + temp2
If (temp1 = 0) Or (temp2 = 0) Then
    Text18.Text = 0
Else
    Text18.Text = CStr(100 * ((temp1 + temp2) / (temp3 + temp4))) + "%"
End If

Call Close_link


End Sub

Private Sub Command4_Click()
On Error Resume Next
 If Text14.Text = "" Then
   A = MsgBox("请完整填写数据", vbOKOnly, "错误")
  Exit Sub
 End If
 
 Call Open_link
  sql1 = "select * from xdgl_ddyb_aqsc where rq='" & DTPicker1.Value & "' "
  Set RS = ZHCX.Execute(sql1, 0)
   If RS.EOF Then
      sql1 = "insert xdgl_ddyb_aqsc (rq,aqyxjl,jtzlp,zhzlp,hj,hgl) values('" & DTPicker1.Value & "','" & Trim(Text14.Text) & "','" & Trim(Text15.Text) & "'," & Trim(Text16.Text) & "," & Trim(Text17.Text) & ",'" & Trim(Text18.Text) & "')"
   Else
1234

⌨️ 快捷键说明

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