怎样将表单数据按界面格式导入到excel中 ,急!!!

用VB控制EXCEL生成报表
做为一种简捷、系统的 Windows应用程序开发工具，Visual Basic 5 具有强大的数据处理功能，提供了多种数据访问方法，可以方便地存取Microsoft SQL Server、Oracle、XBase等多种数据库，被广泛应用于建立各种信息管理系统。但是，VB缺乏足够的、符合中文习惯的数据表格输出功能，虽然使用Crystal Report控件及 Crystal Reports程序可以输出报表，但操作起来很麻烦，中文处理能力也不理想。Excel作为Micorsoft公司的表格处理软件在表格方面有着强大的功能，我们可用VB5编写直接控制Excel操作的程序,方法是用VB的OLE自动化技术获取Excel 97 的控制句柄,从而直接控制Excel 97的一系列操作。下面给出一个实例：首先建立一个窗体（FORM1）在窗体中加入一个DATA控件和一按钮，引用Microsoft Excel类型库:从"工程"菜单中选择"引用"栏;选择Microsoft Excel 8.0 Object Library;选择"确定"。在FORM的LOAD事件中加入：
　　Data1.DatabaseName = 数据库名称
　　Data1.RecordSource = 表名
　　Data1.Refresh在按钮的CLICK事件中加入
　　Dim Irow, Icol As Integer
　　Dim Irowcount, Icolcount As Integer
　　Dim Fieldlen() "存字段长度值
　　Dim xlApp As Excel.Application
　　Dim xlBook As Excel.Workbook
　　Dim xlSheet As Excel.Worksheet　　Set xlApp = CreateObject("Excel.Application")
　　Set xlBook = xlApp.Workbooks.Add
　　Set xlSheet = xlBook.Worksheets(1)　　With Data1.Recordset
　　.MoveLast　　If .RecordCount < 1 Then
　　　　MsgBox ("Error 没有记录!")
　　　　Exit Sub
　　End If　　Irowcount = .RecordCount "记录总数
　　Icolcount = .Fields.Count "字段总数　　ReDim Fieldlen(Icolcount)
　　.MoveFirst8　　For Irow = 1 To Irowcount + 1
　　　For Icol = 1 To Icolcount
　　Select Case Irow
　　Case 1 "在Excel中的第一行加标题
　　xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1).Name
　　Case 2 "将数组FIELDLEN()存为第一条记录的字段长　　If IsNull(.Fields(Icol - 1)) = True Then
　　　　Fieldlen(Icol) = LenB(.Fields(Icol - 1).Name)
　　　　　"如果字段值为NULL,则将数组Filelen(Icol)的值设为标题名的宽度
　　Else
　　　　Fieldlen(Icol) = LenB(.Fields(Icol - 1))
　　End If　　xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
　　　"Excel列宽等于字段长
　　xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
　　　"向Excel的CellS中写入字段值
　　Case Else
　　Fieldlen1 = LenB(.Fields(Icol - 1))　　If Fieldlen(Icol) < Fieldlen1 Then
　　xlSheet.Columns(Icol).ColumnWidth = Fieldlen1
　　　"表格列宽等于较长字段长
　　Fieldlen(Icol) = Fieldlen1
　　　"数组Fieldlen(Icol)中存放最大字段长度值
　　Else
　　　xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
　　End If　　xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
　　End Select
　　Next
　　If Irow <> 1 Then
　　If Not .EOF Then .MoveNext
　　End If
　　Next
　　With xlSheet
　　.Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Name = "黑体"
　　　"设标题为黑体字
　　.Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Bold = True
　　　"标题字体加粗
　　.Range(.Cells(1, 1), .Cells(Irow, Icol - 1)).Borders.LineStyle = xlContinuous
　　　"设表格边框样式
　　End With
　　xlApp.Visible = True "显示表格
　　xlBook.Save "保存
　　Set xlApp = Nothing "交还控制给Excel
　　End With本程序在中文Windows98、中文VB5下通过。
------------------------------------------------------------------
个人专栏：http://www.csdn.net/develop/author/netauthor/lihonggen0/
------------------------------------------------------------------

Private Sub FlatBttn5_Click()

    '存字段长度值
    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)    With Rs_Dzgl_Receipt
        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Sub
        End If
        xlSheet.Cells(1, 4).Value = .Fields("bt")
        xlSheet.Cells(2, 1).Value = .Fields("invoice")
        xlSheet.Cells(2, 9).Value = .Fields("packdate")
        xlSheet.Cells(3, 1).Value = .Fields("")

        '合并单元格
        Dim nIcol As Integer

        xlSheet.Range(xlSheet.Cells(3, 1), xlSheet.Cells(5, 9)).Select
            With xlApp.Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
               .MergeCells = True
            End With

        xlSheet.Range(xlSheet.Cells(1, 1), xlSheet.Cells(1, 9)).Select
            With xlApp.Selection
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .WrapText = False
                .Orientation = 0
                .AddIndent = False
                .ShrinkToFit = False
               .MergeCells = True
            End With
        '网格线
        With xlSheet
            .Range(.Cells(1, 1), .Cells(1, 9)).Font.Name = "黑体"
            '设标题为黑体字
            .Range(.Cells(1, 1), .Cells(1, 9)).Font.Bold = True
            '标题字体加粗
            .Range(.Cells(1, 1), .Cells(1, 9)).Borders.LineStyle = xlContinuous
            '设表格边框样式
        End With

        '显示表格
        Dim ExclFileName As String
        ExclFileName = App.Path & "\箱单" & Text1(1).Text & ".xls"
        If Dir(ExclFileName) <> "" Then
            Kill ExclFileName
        End If
        xlSheet.SaveAs (ExclFileName)
        xlApp.Application.Visible = True
        '交还控制给Excel
        xlSheet.PrintPreview
       ' xlApp.Application.Quit
       ' xlApp.Quit
    End With
'.MergeCells = True
End Sub

to:lihonggen0(李洪根,用.NET，标准答案来了) 我要按界面格式来导,而不是单纯的表结构

调试易

怎样将表单数据按界面格式导入到excel中 ,急!!!

解决方案 »