frmtj.frm

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

    sendexcel.Selection.RowHeight = 54.75
    sendexcel.Selection.RowHeight = 58.5
    sendexcel.Rows("2:2").RowHeight = 30
    sendexcel.Rows("5:5").Select
    sendexcel.Selection.RowHeight = 22.5
    sendexcel.ActiveWindow.ScrollRow = 3
    sendexcel.Rows("8:8").RowHeight = 23.25
    sendexcel.Range("H7").Select
    sendexcel.ActiveWindow.ScrollRow = 4
    sendexcel.ActiveWindow.ScrollRow = 1
    sendexcel.Range("C3:F12").Select
    With sendexcel.Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
    End With
      sendexcel.Sheets("Sheet1").Select
    With sendexcel.ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .RightFooter = ""
        .CenterFooter = ""
        .LeftMargin = Application.InchesToPoints(1.5)
        .RightMargin = Application.InchesToPoints(0.32)
        .TopMargin = Application.InchesToPoints(1.5)
        .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 = xlLandscape
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 100
    End With

    sendexcel.ActiveWindow.SelectedSheets.PrintPreview
    


            
End Sub

Private Sub Command2_Click()
 Dim sendexcel As Excel.Application
 Set sendexcel = CreateObject("Excel.Application")
     sendexcel.Visible = True
     sendexcel.Workbooks.Add

If Option2.Value Then
   If Option3.Value Then
        sql1 = "select * from xdgl_zhczpzb where zxrq between  '" & Format(DTPicker1.Value, "yyyy-mm-01") & "' and '" & DateAdd("d", -1, DateAdd("m", 1, Format(DTPicker1.Value, "yyyy-mm-01"))) & "' "
   Else
        sql1 = "select * from xdgl_zxczpzb where zxsj between  '" & Format(DTPicker1.Value, "yyyy-mm-01") & "' and '" & DateAdd("d", -1, DateAdd("m", 1, Format(DTPicker1.Value, "yyyy-mm-01"))) & "' "
   End If
 Else
  If Option3.Value Then
        sql1 = "select * from xdgl_zhczpzb where zxrq between  '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & Format(DTPicker1.Value, "yyyy-12-31") & "' "
  Else
        sql1 = "select * from xdgl_zxczpzb where zxsj between  '" & Format(DTPicker1.Value, "yyyy-01-01") & "' and '" & Format(DTPicker1.Value, "yyyy-12-31") & "' "
  End If
End If
         

      sendexcel.Cells(1, 1).Value = "票号"
      sendexcel.Cells(1, 2).Value = "执行情况"
      sendexcel.Cells(1, 3).Value = "评价结果"
      sendexcel.Cells(1, 4).Value = "操作单位"
      sendexcel.Cells(1, 5).Value = "操作任务"
    sendexcel.Columns("A:A").ColumnWidth = 15
    sendexcel.Columns("B:B").ColumnWidth = 10
    sendexcel.Columns("C:C").ColumnWidth = 10
    sendexcel.Columns("D:D").ColumnWidth = 9
    sendexcel.Columns("E:E").ColumnWidth = 60
       sendexcel.Rows("1:1").RowHeight = 22.5
       sendexcel.Rows("1:1").Select
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    sendexcel.Rows("1:1").Select
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
    sendexcel.Range("A1:E1").Select
    With sendexcel.Selection.Interior
        .ColorIndex = 10
        .Pattern = xlSolid
    End With
    
    Call Open_link
    Debug.Print sql1
       Set RS = ZHCX.Execute(sql1, 0)
       
      j = 2
        Do While Not RS.EOF
         If Option3.Value Then
                If IsNull(RS(1)) Then
                    sendexcel.Cells(j, 1).Value = ""
                Else
                    sendexcel.Cells(j, 1).Value = CStr(Trim(RS("zlph")))
                End If
                
                If IsNull(RS(3)) Then
                    sendexcel.Cells(j, 2).Value = ""
                Else
                    sendexcel.Cells(j, 2).Value = CStr(Trim(RS("zxjg")))
                End If
                
                If IsNull(RS(4)) Then
                    sendexcel.Cells(j, 3).Value = ""
                Else
                    sendexcel.Cells(j, 3).Value = CStr(Trim(RS("pjjg")))
                End If
                
                If IsNull(RS(6)) Then
                    sendexcel.Cells(j, 4).Value = ""
                Else
                    sendexcel.Cells(j, 4).Value = CStr(Trim(RS("czdw")))
                End If
                If IsNull(RS(7)) Then
                    sendexcel.Cells(j, 5).Value = ""
                Else
                    sendexcel.Cells(j, 5).Value = CStr(Trim(RS("czrw")))
                End If
           Else
                If IsNull(RS(4)) Then
                    sendexcel.Cells(j, 1).Value = ""
                Else
                    sendexcel.Cells(j, 1).Value = CStr(Trim(RS("zxlph")))
                End If
                
                If IsNull(RS(5)) Then
                    sendexcel.Cells(j, 2).Value = ""
                Else
                    sendexcel.Cells(j, 2).Value = CStr(Trim(RS("zxqk")))
                End If
                
                If IsNull(RS(6)) Then
                    sendexcel.Cells(j, 3).Value = ""
                Else
                    sendexcel.Cells(j, 3).Value = CStr(Trim(RS("pjqk")))
                End If
                
                If IsNull(RS(8)) Then
                    sendexcel.Cells(j, 4).Value = ""
                Else
                    sendexcel.Cells(j, 4).Value = CStr(Trim(RS("czdw")))
                End If
                If IsNull(RS(7)) Then
                    sendexcel.Cells(j, 5).Value = ""
                Else
                    sendexcel.Cells(j, 5).Value = CStr(Trim(RS("czrw")))
                End If
         End If
         
            RS.MoveNext
            j = j + 1
       Loop
  
       Call Close_link
       
    sendexcel.Columns("E:E").Select
    With sendexcel.Selection
        .HorizontalAlignment = xlLeft
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    sendexcel.Range("E1").Select
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
     sendexcel.Columns("A:D").Select
    With sendexcel.Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
     sendexcel.Range("A1:E1").Select
     sendexcel.Selection.Interior.ColorIndex = 41
     sendexcel.Selection.Interior.ColorIndex = 33
     sendexcel.Range("E5").Select
    sendexcel.Range("A3").Select
    If j = 2 Then
       j = 3
    End If
    s_a = "A1: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
    sendexcel.ActiveWindow.SelectedSheets.PrintPreview
    
End Sub

Private Sub Form_Load()
On Error Resume Next
 DTPicker1.Value = Format(DateAdd("m", -1, Now), "yyyy-mm")
End Sub

Private Sub Option1_Click()
Call Option2_Click
End Sub

Private Sub Option2_Click()
 If Option2.Value Then
    DTPicker1.CustomFormat = "yyyy-MM"
 Else
    DTPicker1.CustomFormat = "yyyy"
 End If

End Sub