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

📄 frmjjbb.frm

📁 县级电力调度管理信息系统。VB6.0开发。 DMIS调度子系统包括以下功能模块:调度操作票管理、调度运行日志、调度交接班管理、调度值班管理、调度报表管理、调度文档、避峰拉闸限电管理等7个业务模块。
💻 FRM
📖 第 1 页 / 共 3 页
字号:
                 DataGrid1.Columns(0).Value = ID + j
                 DataGrid1.Columns(1).Value = DataGrid2.Columns(1).Value
                 DataGrid1.Columns(2).Value = Format(DTPicker1.Value, "yyyy-mm-dd")
                 DataGrid1.Columns(3).Value = ZBBC
                 DataGrid1.Columns(4).Value = DataGrid2.Columns(4).Value
                 DataGrid1.Columns(5).Value = Trim(DataGrid2.Columns(5).Value)
                 DataGrid1.Columns(6).Value = ID + j
                 j = j + 1
                 Adodc2.Recordset.MoveNext
                 Loop
       
              End If
         End If
     End If
     If Adodc1.Recordset.EOF Then
     Else
          Adodc1.Recordset.Update
     End If
     Adodc1.Refresh
     DataGrid1.Refresh
     Call sx
 Call Close_link
End Sub

Private Sub Command5_Click()
Dim b(6) As String
'Unload ActiveReport2
'ActiveReport2.Show
'ActiveReport2.DataControl1.Source = "select * from xdgl_jjbfb where jbrq='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' and jbbc='" & Trim(Combo2.Text) & "' "
'ActiveReport2.DataControl1.Refresh
'ActiveReport2.Label2 = Format(DTPicker1.Value, "yyyy年mm月dd日")
'ActiveReport2.Label3 = Trim(Combo2.Text)


'ActiveReport2.PageSetup
'ActiveReport2.MaxPages
      Dim sendexcel As Excel.Application
      Command5.Enabled = False
      Set sendexcel = CreateObject("excel.Application")

          sendexcel.Workbooks.Add
       sql1 = Adodc1.RecordSource
       Call Open_link

           sendexcel.Columns("A:A").ColumnWidth = 3
           sendexcel.Columns("B:B").ColumnWidth = 20
           sendexcel.Columns("C:C").ColumnWidth = 20
           sendexcel.Columns("D:D").ColumnWidth = 20
           sendexcel.Columns("E:E").ColumnWidth = 20
b(0) = "交待事项"
b(1) = "系统事故及异常"
b(2) = "小水火电"
b(3) = "通信自动化"
b(4) = "保护及自动装置"
b(5) = "其它"
b(6) = "运行方式"
j = 3
For i = 0 To 6
        sql1 = "select * from xdgl_jjbfb where jbrq='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "'  and jbbc='" & Trim(Combo2.Text) & "' and jllx='" & b(i) & "' order by jlxh"
        Set RS = ZHCX.Execute(sql1, 0)
        Debug.Print sql1
        If Not RS.EOF Then
               s_a = "A" & CStr(j) & ":E" & CStr(j)
                  sendexcel.Range(s_a).Select
                  With sendexcel.Selection
                    .HorizontalAlignment = xlLeft
                    .VerticalAlignment = xlCenter
                    .WrapText = True
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .MergeCells = True
                End With
                sendexcel.Cells(j, 1).Value = b(i)
                sendexcel.Range(s_a).Select
                sendexcel.Selection.Font.Bold = True
                With sendexcel.Selection.Font
                    .Name = "楷体_GB2312"
                    .Size = 12
                    .Strikethrough = False
                    .Superscript = False
                    .Subscript = False
                    .OutlineFont = False
                    .Shadow = False
                    .Underline = xlUnderlineStyleNone
                End With

                j = j + 1
                
          Do While Not RS.EOF
                  s_a = "A" & CStr(j) & ":E" & CStr(j)
                  sendexcel.Range(s_a).Select
                  With sendexcel.Selection
                    .HorizontalAlignment = xlLeft
                    .VerticalAlignment = xlCenter
                    .WrapText = True
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .MergeCells = True
                End With
                If IsNull(RS(5)) Then
                    sendexcel.Cells(j, 1).Value = ""
                Else
                    sendexcel.Cells(j, 1).Value = CStr(RS(1)) + "." + CStr(Trim(RS(5)))
                End If
                s_a = CStr(j) + ":" + CStr(j)
                If Len(CStr(RS(1)) + "." + CStr(Trim(RS(5)))) < 60 Then
                        sendexcel.Rows(s_a).RowHeight = 12
                 Else
                    Debug.Print Len(CStr(RS(1)) + "." + CStr(Trim(RS(5))))
                        sendexcel.Rows(s_a).RowHeight = 25
                End If
                sendexcel.Range(s_a).Select
                With sendexcel.Selection.Font
                    .Name = "楷体_GB2312"
                    .Size = 10
                    .Strikethrough = False
                    .Superscript = False
                    .Subscript = False
                    .OutlineFont = False
                    .Shadow = False
                    .Underline = xlUnderlineStyleNone
                End With
            
            RS.MoveNext
            j = j + 1
         Loop
       If RS.State Then
          RS.Close
       End If
      End If
Next i
If j <= 43 Then
   For i = j To 43
                  s_a = "A" & CStr(i) & ":E" & CStr(i)
                  sendexcel.Range(s_a).Select
                  With sendexcel.Selection
                    .HorizontalAlignment = xlLeft
                    .VerticalAlignment = xlCenter
                    .WrapText = True
                    .Orientation = 0
                    .AddIndent = False
                    .IndentLevel = 0
                    .ShrinkToFit = False
                    .MergeCells = True
                End With
   Next i
   j = 43
End If
  sendexcel.Sheets("Sheet1").Select
    With sendexcel.ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .RightFooter = ""
        .CenterFooter = ""
        .LeftMargin = Application.InchesToPoints(0.63)
        .RightMargin = Application.InchesToPoints(0.32)
        .TopMargin = Application.InchesToPoints(1)
        .BottomMargin = Application.InchesToPoints(0.54)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
       ' .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
    End With
    
   s_a = "A3:E" & 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
   j = j + 1
   If j > 44 Then
      j = 44
    End If
   sendexcel.Cells(j, 2).FormulaR1C1 = "交  班  人:"
   sendexcel.Cells(j, 4).FormulaR1C1 = "接  班  人:"
   sendexcel.Range("A1:E1").Select
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = True
    End With
    sendexcel.Rows("1:1").RowHeight = 30
    sendexcel.Cells(1, 1).Value = "交接班记录"
    sendexcel.Range("A1:E1").Select
    With sendexcel.ActiveCell.Font
        .Name = "楷体_GB2312"
        .FontStyle = "加粗"
        .Size = 24
        .ColorIndex = 11
    End With
    sendexcel.Range("A1:E1").Select
    sendexcel.Selection.Font.ColorIndex = 0
    sendexcel.Selection.Font.Bold = True
    sendexcel.Cells(2, 3).FormulaR1C1 = Format(DTPicker1.Value, "yyyy年mm月dd日")
    sendexcel.Cells(2, 4).FormulaR1C1 = Trim(Combo2.Text)
    Select Case DatePart("w", CDate(DTPicker1.Value))
    Case 2
        temp = "一"
    Case 3
        temp = "二"
    Case 4
        temp = "三"
    Case 5
        temp = "四"
    Case 6
        temp = "五"
    Case 7
        temp = "六"
    Case 1
        temp = "日"
    End Select
    sendexcel.Cells(2, 5).Value = "星期" + CStr(temp)
          sendexcel.Visible = True
    sendexcel.ActiveWindow.SelectedSheets.PrintPreview
    Call Close_link
Command5.Enabled = True
End Sub

Private Sub DataGrid1_DblClick()
If Adodc1.Recordset.EOF Then
  Exit Sub
End If
If IsNull(DataGrid1.Columns(5).Value) Then
   Text3.Text = ""
Else
    Text3.Text = DataGrid1.Columns(5).Value
    Text4.Text = DataGrid1.Columns(0).Value
    Combo1.Text = DataGrid1.Columns(4).Value
End If

End Sub

Private Sub DataGrid1_LostFocus()
If Adodc1.Recordset.EOF Then
Else
  Adodc1.Recordset.Update
End If

End Sub

Private Sub DTPicker1_Change()
Call Check1_Click
End Sub

Private Sub DTPicker1_Click()
Call Check1_Click
End Sub

Private Sub DTPicker2_CallbackKeyDown(ByVal KeyCode As Integer, ByVal Shift As Integer, ByVal CallbackField As String, CallbackDate As Date)
  Adodc2.ConnectionString = "PROVIDER=MSDASQL;dsn=ddmis;uid=mis;pwd=mis005;database=zhcx"
   If Option1.Value Then
      Adodc2.RecordSource = "select * from xdgl_zbjlb where dlsj='" & Format(DTPicker2.Value, "yyyy-mm-dd") & "'  and zbbc='" & Trim(Combo3.Text) & "'"
      Adodc2.Refresh
      DataGrid2.Refresh
      Call sx1
   Else
     Adodc2.RecordSource = "select * from xdgl_jjbfb where jbrq='" & Format(DTPicker2.Value, "yyyy-mm-dd") & "'  and jbbc='" & Trim(Combo3.Text) & "'"
     Adodc2.Refresh
     DataGrid2.Refresh
     Call sx2
   End If
    
End Sub

Private Sub DTPicker2_Click()
   Call Option1_Click
End Sub

Private Sub Form_Load()
On Error Resume Next
Adodc1.ConnectionString = "PROVIDER=MSDASQL;dsn=ddmis;uid=mis;pwd=mis005;database=zhcx"
Adodc2.ConnectionString = "PROVIDER=MSDASQL;dsn=ddmis;uid=mis;pwd=mis005;database=zhcx"

Adodc1.RecordSource = "select * from xdgl_jjbfb where jbrq='" & Format(DTPicker1.Value, "yyyy-mm-dd") & "' "
Adodc1.Refresh
Combo2.Clear
Combo2.AddItem "早班"
Combo2.AddItem "中班"
Combo2.AddItem "晚班"
Combo2.Text = ZBBC
Combo3.Clear
Combo3.AddItem "早班"
Combo3.AddItem "中班"
Combo3.AddItem "晚班"
Combo3.Text = ZBBC
DTPicker1.Value = Format(Now, "yyyy-mm-dd")
DTPicker2.Value = Format(Now, "yyyy-mm-dd")
Combo1.Clear
Combo1.AddItem "交待事项"
Combo1.AddItem "系统事故及异常"
Combo1.AddItem "小水火电"
Combo1.AddItem "通信自动化"
Combo1.AddItem "保护及自动装置"
Combo1.AddItem "其它"
Combo1.AddItem "运行方式"
Combo1.ListIndex = 0
Text1.Text = cname
Call Option1_Click
Call sx
End Sub
Sub sx()
DataGrid1.Columns(0).Visible = False
DataGrid1.Columns(1).Caption = "序号"
DataGrid1.Columns(1).Width = 700
DataGrid1.Columns(2).Visible = False
DataGrid1.Columns(3).Visible = False
DataGrid1.Columns(4).Visible = True
DataGrid1.Columns(4).Caption = "记录类型"
DataGrid1.Columns(5).Caption = "记录内容"
DataGrid1.Columns(5).Width = 10000
DataGrid1.Columns(6).Visible = False
End Sub


Private Sub Option1_Click()
    Adodc2.ConnectionString = "PROVIDER=MSDASQL;dsn=ddmis;uid=mis;pwd=mis005;database=zhcx"
   If Option1.Value Then
      Adodc2.RecordSource = "select * from xdgl_zbjlb where dlsj='" & Format(DTPicker2.Value, "yyyy-mm-dd") & "'  and zbbc='" & Trim(Combo3.Text) & "'"
      Adodc2.Refresh
      DataGrid2.Refresh
      Call sx1
   Else
     Adodc2.RecordSource = "select * from xdgl_jjbfb where jbrq='" & Format(DTPicker2.Value, "yyyy-mm-dd") & "'  and jbbc='" & Trim(Combo3.Text) & "'"
     Adodc2.Refresh
     DataGrid2.Refresh
     Call sx2
   End If
    
   
End Sub
Sub sx1()
   DataGrid2.Columns(0).Visible = False
   DataGrid2.Columns(2).Visible = False
   DataGrid2.Columns(3).Visible = False
   DataGrid2.Columns(4).Visible = False
   DataGrid2.Columns(5).Visible = False
   DataGrid2.Columns(6).Visible = False
   DataGrid2.Columns(7).Visible = False
   DataGrid2.Columns(8).Width = 6200
   DataGrid2.Columns(9).Visible = False
   DataGrid2.Columns(10).Visible = False
   DataGrid2.Columns(1).Caption = "序号"
   DataGrid2.Columns(8).Caption = "内容"
End Sub
Sub sx2()
   DataGrid2.Columns(0).Visible = False
   DataGrid2.Columns(2).Visible = False
   DataGrid2.Columns(3).Visible = False
   DataGrid2.Columns(4).Visible = False
   DataGrid2.Columns(6).Visible = False
   DataGrid2.Columns(1).Caption = "序号"
   DataGrid2.Columns(5).Caption = "内容"
   DataGrid2.Columns(5).Width = 6200
End Sub

Private Sub Option2_Click()
  Call Option1_Click
End Sub

⌨️ 快捷键说明

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