Question

如何在VB的窗体中显示Excel报表

因为由于学习的需要，要做一个基于EXCEL的报表通用报表设计，系统的功能大概是这样的，用户在Excel中指定模板，程序能读取该模板，并且根据此模板形成报表。程序提供对外接口，接受数据形成报表。
目前我实现了调出一个打开文件菜单，但是找不到相应的代码来打开Excel文件。注：打开的Excel表格是显示在VB的窗体中。
请高手给段代码。分是低了点，答了再追加吧。
若是可能，还请一并提供编辑该报表的代码。谢谢

Answer 1

Option Explicit
Public xlApp As New Excel.Application
Public xlBook As Excel.Workbook
Public xlSheet As Excel.Worksheet

Public Function SaveAsExcel(rsErr As ADODB.Recordset, sFileName As String, _
sSheet As String, sOpen As String, ByVal field As String)
Dim fd As field
Dim CellCnt As Integer
Dim i As Integer
Dim fieldArr() As String
Dim t As Integer
fieldArr = Split(field, "|")

On Error GoTo Err_Handler

Screen.MousePointer = vbHourglass

Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add

'获取字段名
CellCnt = 1
xlSheet.name = sSheet
For Each fd In rsErr.Fields '添加listview标题
xlSheet.Cells(1, CellCnt).value = fieldArr(CellCnt - 1)
xlSheet.Cells(1, CellCnt).Interior.ColorIndex = 33
xlSheet.Cells(1, CellCnt).Font.Bold = True
xlSheet.Cells(1, CellCnt).BorderAround xlContinuous
CellCnt = CellCnt + 1
Next

rsErr.MoveFirst
i = 2
t = 1
Do While Not rsErr.EOF()
CellCnt = 1
For Each fd In rsErr.Fields
If fd.name = "Company_Id" Or fd.name = "Drugs_Id" Then
xlSheet.Cells(i, CellCnt).value = t
Else
xlSheet.Cells(i, CellCnt).NumberFormat = "@"
xlSheet.Cells(i, CellCnt).value = rsErr.Fields(fd.name).value
End If
CellCnt = CellCnt + 1
Next
rsErr.MoveNext
i = i + 1
t = t + 1
Loop

'自动填充
CellCnt = 1
For Each fd In rsErr.Fields
xlSheet.Columns(CellCnt).AutoFit
CellCnt = CellCnt + 1
Next

xlSheet.SaveAs sFileName ' 保存 Worksheet.
xlBook.Close ' 关闭 Workbook
xlApp.Quit ' 关闭 Excel

If sOpen = "YES" Then ' 打开 Excel Workbook
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(sFileName)
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Application.Visible = True
Else
Set xlApp = Nothing '释放 Excel 对象.
Set xlBook = Nothing
Set xlSheet = Nothing
End If

Err_Handler:
If Err = 0 Then
Screen.MousePointer = vbDefault
Else
MsgBox "未知错误！ " & vbCrLf & vbCrLf & Err & ":" & Error & " ", vbExclamation
Screen.MousePointer = vbDefault
End If
End Function