许多朋友把EXCEL作为报表的工具，把数据写入EXCEL并不困难，但存在一些问题，如：客户

修改了报表的格式，或者把设计好的报表文件删除了，如何解决这些问题呢？搜遍了国内外的站

点，亦未发现有什么好的办法。

  有的朋友给EXCEL文件加密码，这种办法只防止了客户修改报表格式，如果客户移动或删除了

这个报表文件，仍然会出问题。现在我们来手绝的：把设计好的空白报表加到资源文件里面，每次

报表的时候先把资源文件里面的EXCEL报表写到当前目录下，然后由程序填写数据，或显示或打

印！

  开始吧！先做一些准备工作，在这里假设已准备了以下东东：

在当前目录下有一access2000数据库db1.mdb，打开密码是7281322，内有一张表MonRep存放着

要报表的数据；设计好的空白EXCEL2000报表rp.xls，打开密码也是7281322。

打开VB，新建一个工程，在"工程"→"引用"里面选取Microsoft ActiveX Data Object 2.1 

Library和Microsoft Excel 9.0 Object Library；

在"外接程序"→"外接程序管理器"里面加载"VB 6 资源编辑器"，在"工程资源管理器"里面点击鼠

标右键，选取"添加资源文件"，随便给资源文件起个名字，出现"VB资源编辑器"后，点"添加自定

义资源"按钮，选取你设计好的报表rp.xls，点击"保存"按钮，注意：这里使用了默认的类

型"CUSTOM"和默认的标识号101，实际应用中你可做修改。

按下Ctrl-t，选取Microsoft DataGrid Control 6.0(OLEDB)在默认窗体Form1上画一个

DataGrid，默认名称DataGrid1。

在窗体里添加如下代码：

Private Sub Form_Load()

  Dim rst As Recordset

  Set Cnn1 = New ADODB.Connection

  CnnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path 

& "\db1.mdb" _

& ";Mode=Read|Write;Persist Security Info=False;Jet OLEDB:Database 

Password=7281322"

Cnn1.Open CnnStr

  Sql = "SELECT * FROM MonRep"

  Set rst = New ADODB.Recordset

  rst.CursorLocation = adUseClient

  rst.Open Sql, Cnn1, adOpenKeyset, adLockOptimistic, adCmdText

 Set DataGrid1.DataSource = rst

End Sub

Private Sub Form_Resize()

DataGrid1.Width = 0.95 * Me.Width

DataGrid1.Height = 0.75 * Me.Height

End Sub

在窗体的"通用"里面添加以下代码：（注意API函数的声明一定要写在一行里）

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal 

hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal 

lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function WriteFile Lib "kernel32" (ByVal hFile As Long, 

lpBuffer As Any, ByVal nNumberOfBytesToWrite As Long, lpNumberOfBytesWritten As 

Long, ByVal lpOverlapped As Any) As Long

Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal 

lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, 

ByVal lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal 

dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long

Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As 

Long

Const WM_CLOSE = &H10

Const GENERIC_WRITE = &H40000000

Const CREATE_ALWAYS = 2

Const FILE_ATTRIBUTE_NORMAL = &H80

Public Sub CopyExcel()

  Dim hNewFile As Long, bBytes() As Byte

  Dim nSize As Long

  Dim hwnd

  hwnd = FindWindow("XLMAIN", "Microsoft Excel - rp.xls")

  If hwnd <> 0 Then

    SendMessage hwnd, WM_CLOSE, 0, 0'如果客户没有关闭该报表，提示他关闭它

    Exit Sub

  End If

  If Dir(App.Path & "\rp.xls") = "rp.xls" Then

  Kill App.Path & "\rp.xls"

  End If

  bBytes = LoadResData(101, "CUSTOM")

  hNewFile = CreateFile(App.Path & "\rp.xls", GENERIC_WRITE, 0, 0, 

CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0)

nSize = UBound(bBytes) - LBound(bBytes) + 1

  WriteFile hNewFile, bBytes(0), nSize, nSize, ByVal 0&

  CloseHandle hNewFile

End Sub

  在窗体上画一按钮，添加以下代码：

Private Sub Command1_Click()

Me.MousePointer = 11

CopyExcel

  Dim ex As Object

  Dim i As Integer

  Dim j As Integer

  Dim XlApp As Excel.Application

  Dim xlBook As Excel.Workbook

  Dim xlSheet As Excel.Worksheet

  Set XlApp = CreateObject("Excel.Application")

  XlApp.Visible = True

  Set xlBook = XlApp.Workbooks.Open(App.Path & "\rp.xls", , , , 7281322)

  Set xlSheet = xlBook.Worksheets(1)

  Dim rst As Recordset

  Set Cnn1 = New ADODB.Connection

  CnnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & App.Path 

& "\db1.mdb" _

  & ";Mode=Read|Write;Persist Security Info=False;Jet OLEDB:Database 

Password=7281322"

  Cnn1.Open CnnStr

  Sql = "SELECT * FROM MonRep"

  Set rst = New ADODB.Recordset

  rst.CursorLocation = adUseClient

  rst.Open Sql, Cnn1, adOpenKeyset, adLockOptimistic, adCmdText

  rst.MoveFirst

  For j = 0 To rst.RecordCount - 1

  For i = 3 To rst.Fields.Count

  xlSheet.Cells(i + 2, j + 3) = rst.Fields(i - 1).Value

  Next i

  rst.MoveNext

  Next j

  For i = 3 To rst.Fields.Count

  zzz = 0

  For j = 0 To rst.RecordCount - 1

  zzz = zzz + xlSheet.Cells(i + 2, j + 3)

  Next j

   xlSheet.Cells(i + 2, 16) = zzz

  Next i

  xlSheet.Cells(3, 15) = Date

' ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True

' xlBook.Close

' XlApp.Quit

Me.MousePointer = 0

End Sub

  如果你不想显示而是想直接打印报表，可以把XlApp.Visible = True去掉，而启用最后加注

释的三行命令。

搞定了！按下F5运行后点击按钮，你会看到生成的报表。利用这种方法，你再也不用担心客户破坏

你的报表了，爽吗？如果你懒得自己做一遍，到第一VB论坛http://www.vbgood.com去下载我的示

例源代码看看吧。该示例代码在以下环境下通过：

    Win98+VB6SP3+Excl2000+Access2000