用EXCEL作报表程序有谁会,请高手说一说

Question

先引用Excel Object Library,仔细看下面的代码(测试通过)Private Sub butPrint_Click()
    Dim strFile, strSource As String
    Dim lngCount As Long
    Dim xlApp As New Excel.Application
    Dim xlbook As Excel.Workbook
    Dim xlsheet As Excel.Worksheet
    strSource = App.Path & "\Reports\Ac.xls"
    strFile = App.Path & "\Ac.xls"
    On Error GoTo Handle
    FileCopy strSource, strFile
    Set xlbook = xlApp.Workbooks.Open(strFile)
    Set xlsheet = xlApp.Worksheets("劳模甲种")
    If rstRecordset.RecordCount >= 1 Then
        prgBar.Max = rstRecordset.RecordCount + 1
        With xlsheet
            For lngCount = 1 To 10
                .Columns(lngCount).HorizontalAlignment = xlHAlignCenter
                .Columns(lngCount).VerticalAlignment = xlVAlignCenter
            Next
            .Columns(4).NumberFormat = "yy-m-d"
            .Columns(7).NumberFormat = "yy-m-d"
            prgBar.Visible = True
            For lngCount = 2 To rstRecordset.RecordCount + 1
                prgBar.Value = lngCount
                .Cells(lngCount, 1) = rstRecordset!序号
                .Cells(lngCount, 2) = rstRecordset!姓名
                .Cells(lngCount, 3) = rstRecordset!性别
                .Cells(lngCount, 4) = rstRecordset!出生日期
                .Cells(lngCount, 5) = rstRecordset!工作单位
                .Cells(lngCount, 6) = rstRecordset!投保标准
                .Cells(lngCount, 7) = rstRecordset!投保时间
                .Cells(lngCount, 8) = rstRecordset!所在县市
                .Cells(lngCount, 9) = rstRecordset!有效性
                .Cells(lngCount, 10) = rstRecordset!备注
                rstRecordset.MoveNext
            Next
            .Range(.Cells(1, 1), .Cells(rstRecordset.RecordCount + 1, 10)).Borders.LineStyle = xlContinuous
        End With
        prgBar.Visible = False
        rstRecordset.MoveFirst
    End If
    xlbook.Save
    xlApp.Visible = True
    xlsheet.PrintPreview
    xlApp.Quit
    On Error GoTo 0
    Exit Sub
Handle:
    xlApp.Quit
End Sub

Answer 1

Dim x(1 To 4, 1 To 5) As Integer
Dim a, i, j As Integer
Dim b As StringPrivate Sub Command1_Click()
    Dim ex As Object
    Dim exbook As Object
    Dim exsheet As Object
    Set ex = CreateObject("Excel.Application")
    Set exbook = ex.Workbooks().Add
    Set exsheet = exbook.Worksheets("sheet1")
'按控件的内容赋值
'11
    exsheet.Cells(1, 1).Value = Text1.Text
'为同行的几个格赋值
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "表格"
'    ex.Range("c3").Value = "表 格"
    ex.Range("d3").Value = " 春 天 "
    ex.Range("e3").Value = " 夏 天 "
    ex.Range("f3").Value = " 秋 天 "
    ex.Range("g3").Value = " 冬 天 "
'大片赋值
    ex.Range("c4:g7").Value = x
'按变量赋值
  a = 8
  b = "c" & Trim(Str(a))
  ex.Range(b).Value = "下雪"
'另外一种大片赋值
    For i = 9 To 12
    For j = 4 To 7
    exsheet.Cells(i, j).Value = i * j
    Next j
    Next i
'计算赋值
exsheet.Cells(13, 1).Formula = "=R9C4 + R9C5"
'设置字体
Dim exRange As Object
Set exRange = exsheet.Cells(13, 1)
exRange.Font.Bold = True'设置一行为18号字体加黑
 Rows("3:3").Select
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "宋体"
        .Size = 18
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
    End With
'设置斜体
    Range("E2").Select
    Selection.Font.Italic = True
'设置下划线
    Range("E3").Select
    Selection.Font.Underline = xlUnderlineStyleSingle'设置列宽为15
    Selection.ColumnWidth = 15'设置一片数据居中
Range("C4:G7").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .ShrinkToFit = False
        .MergeCells = False
    End With
'设置某区域的小数位数
    Range("F4:F7").Select
    Selection.NumberFormatLocal = "0.00"
    
'求和
    Range("G9:G13").Select
    Range("G13").Activate
    ActiveCell.FormulaR1C1 = "=SUM(R[-4]C:R[-1]C)"
'某列自动缩放宽度
    Columns("C:C").EntireColumn.AutoFit
'画表格
    Range("C4:G7").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        .ColorIndex = xlAutomatic
    End With
'加黑框
Range("C9:G13").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlMedium
        .ColorIndex = xlAutomatic
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
'设置某单元格格式为文本
    Range("E11").Select
    Selection.NumberFormatLocal = "@"
'设置单元格格式为数值
    Range("F10").Select
    Selection.NumberFormatLocal = "0.000_);(0.000)"
'设置单元格格式为时间
    Range("F11").Select
    Selection.NumberFormatLocal = "h:mm AM/PM"'取消选择
Range("C10").Select
'设置横向打印，A4纸张
'    With ActiveSheet.PageSetup
'        .PrintTitleRows = ""
'        .PrintTitleColumns = ""
'    End With
'    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
'        .LeftHeader = ""
'        .CenterHeader = ""
'        .RightHeader = ""
'        .LeftFooter = ""
'        .CenterFooter = ""
'        .RightFooter = ""
'        .LeftMargin = Application.InchesToPoints(0.75)
'        .RightMargin = Application.InchesToPoints(0.75)
'        .TopMargin = Application.InchesToPoints(1)
'        .BottomMargin = Application.InchesToPoints(1)
'        .HeaderMargin = Application.InchesToPoints(0.5)
'        .FooterMargin = Application.InchesToPoints(0.5)
'        .PrintHeadings = False
'        .PrintGridlines = False
'        .PrintComments = xlPrintNoComments
'        .PrintQuality = 300
'        .CenterHorizontally = False
'        .CenterVertically = False
        .Orientation = xlLandscape
'        .Draft = False
        .PaperSize = xlPaperA4
'        .FirstPageNumber = xlAutomatic
'        .Order = xlDownThenOver
'        .BlackAndWhite = False
'        .Zoom = 100
    End With
'跨列居中
    Range("A1:G1").Select
    With Selection
        .HorizontalAlignment = xlCenter
'        .VerticalAlignment = xlBottom
'        .WrapText = False
'        .Orientation = 0
'        .AddIndent = False
'        .ShrinkToFit = False
        .MergeCells = True
    End With
    Selection.Merge'打印表格
ActiveWindow.SelectedSheets.PrintOut Copies:=1'取值
Text1.Text = exsheet.Cells(13, 1)
'保存
ChDir "C:\WINDOWS\Desktop"
ActiveWorkbook.SaveAs FileName:="C:\WINDOWS\Desktop\aaa.xls", FileFormat:=xlNormal, Password:="123", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
   ' 关闭工作表。
   exbook.Close
   '用 Quit 方法关闭 Microsoft Excel
   ex.Quit
   '释放对象
   Set ex = Nothing
   Set exbook = Nothing
   Set exsheet = Nothing
Dim retval
'用excel打开表格
retval = Shell("C:\Program Files\Microsoft Office\Office\EXCEL.EXE" & " " & "C:\WINDOWS\Desktop\aaa.xls", 1)
   End Sub