VB可以调用Excel对象, 你用代码一个个cell去写不就可以吗

解决方案 »

  1.   

    ---- 一. 用VB创建外部EXCEL对象 ---- 大多数大型 ActiveX-enabled 应用程序和其它 ActiveX 部件,在它们的对象层次中都提供了一个顶层外部可创建对象。该对象提供了对该层次中其它对象的访问,并且还提供对整个应用程序起作用的方法和属性。 ---- 例如,每个 Microsoft Office 应用程序提供一个顶层 Application 对象。下面语句显示了对Microsoft Excel的 Application 对象的引用: Dim xlApp As Excel.Application 
    Set xlApp = New Excel.Application ---- 然后,可以用这些变量来访问在EXCEL应用程序中的从属对象、以及这些对象的属性和方法。例如: Set xlApp = CreateObject("Excel.Application") 
    ‘激活EXCEL应用程序 
    xlApp.Visible = False ‘隐藏EXCEL应用程序窗口 
    Set xlBook = xlApp.Workbooks.Open(strDestination) 
    ‘打开工作簿,strDestination为一个EXCEL报表文件 
    Set xlSheet = xlBook.Worksheets(1) 
    ‘设定工作表 ---- 二. 用EXCEL 97设计报表的模版文件 ---- EXCEL 97是一个非常优秀的创建报表的工具。它提供的单元格任意合并、拆分和绘图功能基本上能够满足设计所有复杂报表的需求。它对任意一个单元格的格式随意控制,更为随心所欲地设计报表提供了强大的支持。 ---- 根据用户提供的报表,我们可以很快在EXCEL里生成模版文件。所谓生成模版文件只是为了满足用户多方面的需求而设计的。也是为了适合报表以后的更改而做的一点预备工作。例如用户需要打印几百张职工履历表,但其格式都是一致的,并且随着时间和实际情况的变化,表格格式有可能需要改变,我们设计一个模版文件显然可以“以不变应万变”了。 ---- 生成工作表时我们应当记录下要填充内容的单元格编号和该单元格内要填充的数据字段。这样形成一个表格,在写程序时一目了然。如: Cell(4,2) 职工姓名 Cell(6,6) 毕业学校 
    Cell(4,4) 职工性别 Cell(6,7) 所学专业 
    Cell(4,6) 职工民族 Cell(6,9) 工作时间 
    (表一) ---- 在程序里我们当然不要对模版文件进行操作了,我们只需要对模版文件的一个拷贝进行操作就行(这也是我们设计模版文件的一个目的和好处)。如下面的例子: Dim strSource, strDestination As String 
    strSource = App.Path & "\Excels\RegisterFee.xls"  
    ‘RegisterFee.xls就是一个模版文件 
    strDestination = App.Path & "\Excels\Temp.xls"  
    FileCopy strSource, strDestination 
    ‘将模版文件拷贝到一个临时文件 ---- 三. 生成工作表内容 ---- 有了上述两步工作的铺垫,我们下面接着就只要根据(表一)的格式给各单元格赋值了。如:  datPrimaryRS.Recordset.MoveFirst 
    ‘datPrimaryRS为Data控件 
      If IsNull(datPrimaryRS.Recordset!姓名) = False Then 
      xlSheet.Cells(4, 2) = datPrimaryRS.Recordset!姓名 
      End If 
      If IsNull(datPrimaryRS.Recordset!性别) = False Then 
      xlSheet.Cells(4, 4) = datPrimaryRS.Recordset!性别 
      End If 
      If IsNull(datPrimaryRS.Recordset!民族) = False Then 
      xlSheet.Cells(4, 6) = datPrimaryRS.Recordset!民族 
      End If 
    ……………… ---- 四. 打印报表 ---- 生成了工作表后,就可以对EXCEL发出打印指令了。 ---- 注意在执行打印操作之前应该对EXCEL临时文件执行一次保存操作,以免在退出应用程序后EXCEL还提示用户是否保存已修改的文件,让用户觉得莫名其妙。如下语句: xlBook.Save ‘保存文件 
      xlSheet.PrintOut ‘执行打印 
      xlApp.Quit ‘退出EXCEL ---- 至此应该看到,我们设计的报表打印是通过EXCEL程序来后台实现的。用户根本看不到具体过程,他们只看到一张张漂亮的报表轻易地被打印出来了。
      

  2.   

    如果需要预览的话该怎么办呢 还有就是可能要对预览的内容进行修改 比如用户想要显示这个字段 不想显示另外几个字段 这些不可能我事先知道用户要哪些字段而事先做好那些模板 如果用户有这样的需求 VBA能实现吗 可以用程序来生成EXCEL模板吗?请指教 谢谢!
      

  3.   

    呵呵,再给您看看
    Option ExplicitPrivate Type ExlCell
        Row As Long
        Col As Long
    End TypeDim ExcelSheet As Excel.Application
    Dim ValuesArray() As StringPublic Function MakeExcelFile(MasterRs As ADODB.Recordset, FieldsArray() As String, _
                ReportCaption As String, MasterForm As frmCreateReport)
        
        Dim WS As Worksheet
        Dim StCell As ExlCell
        
        Screen.MousePointer = vbHourglass    Set ExcelSheet = CreateObject("Excel.Application")
        ExcelSheet.Workbooks.Add
        ExcelSheet.Worksheets(1).Name = ReportCaption
        Set WS = ExcelSheet.Worksheets(1)
        
        StCell.Col = 1
        StCell.Row = 3
        Call CopyRecords(MasterRs, WS, StCell, FieldsArray, MasterForm)
        Screen.MousePointer = vbDefault
        
        ExcelSheet.Visible = True
        ExcelSheet.Interactive = True
        Set ExcelSheet = Nothing
    End Function
    Private Sub CopyRecords(RST As ADODB.Recordset, WS As Worksheet, StartingCell As ExlCell, _
                        FieldsArray() As String, MasterForm As frmCreateReport)
        
        Dim SomeArray() As Variant
        Dim Row         As Long
        Dim Col         As Long
        Dim Recs As Integer
        Dim Counter As Integer
        Dim i As Integer
        
        If RST.EOF And RST.BOF Then Exit Sub
        RST.MoveLast
        ReDim SomeArray(RST.RecordCount + 1, UBound(FieldsArray))
        Col = 0
        For Col = 0 To UBound(FieldsArray)
            SomeArray(0, Col) = FieldsArray(Col)
        Next
        RST.MoveFirst
        Recs = RST.RecordCount
        Counter = 0
        For Row = 1 To RST.RecordCount
            Counter = Counter + 1
            If Counter <= Recs Then i = (Counter / Recs) * 100
            MasterForm.UpdateProgress i
            For Col = 0 To UBound(FieldsArray)
                SomeArray(Row, Col) = RST.Fields(FieldsArray(Col)).Value
                If IsNull(SomeArray(Row, Col)) Then _
                SomeArray(Row, Col) = ""
            Next
            RST.MoveNext
        Next    WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _
            WS.Cells(StartingCell.Row + RST.RecordCount, _
            StartingCell.Col + UBound(FieldsArray))).Value = SomeArray
        
        WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _
            WS.Cells(StartingCell.Row + RST.RecordCount, _
            StartingCell.Col + UBound(FieldsArray))).HorizontalAlignment = xlRight
        WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _
            WS.Cells(StartingCell.Row + RST.RecordCount, _
            StartingCell.Col + UBound(FieldsArray))).Borders.LineStyle = xlContinuous
            
            
        WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Merge
        WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Font.Size = 20
        WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Font.Bold = True
        WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).Value = WS.Name
        WS.Range(WS.Cells(1, 1), WS.Cells(1, StartingCell.Col + UBound(FieldsArray))).HorizontalAlignment = xlCenter
        WS.Columns.AutoFit
        MasterForm.UpdateProgress 100
    End Sub其中RecordSet中按照您指定的了
      

  4.   

    SomeArray(Row, Col) = RST.Fields(FieldsArray(Col)).ValueFieldsArray()是您要显示的字段书组明白?
      

  5.   

    For Row = 1 To RST.RecordCount
            Counter = Counter + 1
            If Counter <= Recs Then i = (Counter / Recs) * 100
            MasterForm.UpdateProgress i
            For Col = 0 To UBound(FieldsArray)
                SomeArray(Row, Col) = RST.Fields(FieldsArray(Col)).Value
                If IsNull(SomeArray(Row, Col)) Then _
                SomeArray(Row, Col) = ""
            Next
            RST.MoveNext
        Next
    这里生成报表数据,按照提供的字段