|
许多朋友把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 | 