VB 版 (精华区)

发信人: cdd (平上), 信区: VB
标  题: 创建ActiveX接口以移植Excel工作表(设计DLL)
发信站: 哈工大紫丁香 (2000年06月06日13:59:18 星期二), 站内信件


　　为了创建接口，打开Visual Basic并创建一个标准的可执行项目，并
将他存储在你所选定的ExcelDLL文件夹中。为了加入 Excel引用，点击:
Project>References和 Microsoft Excel 8.0 Object Library。双击:
Project Explorer中的缺省Form，并将之重新命名为 frmMain，设定Form
的标题为Open Northwind Tables，并且增加具有下列属性的控件：
　　为了创建Access数据库和Excel电子表格之间的接口，增加列表1的代
码到Form中。
　　列表1：设计DLL—增加这些代码到Form中以创建接口。
　　 'Declare the new class
　　　Dim mcls_clsExcelWork As New clsExcelWork
　　　Private Sub cmdOpenTable_Click()
　　 'call the CreateWorksheet method of the clsExcelWork
　　 'class.
　　　mcls_clsExcelWork.CreateWorksheet
　　　End Sub
　　　Private Sub Form_Load()
　　 'call the LoadListboxWithTables method.
　　　mcsl_clsExcelWork.LoadListboxWithTables
　　　End Sub
　　　Private Sub Form_Unload(Cancel As Integer)
　　　Set mcls_clsExcelWork = Nothing
　　　End Sub
　　　Private Sub lstTables_DblClick()
　　　Mcls_clsExcelWork.CreateWorksheet
　　　End Sub
　　　增加标准的模块到项目中，并将下列代码加入到该模块中：
　　　Sub Main()
　　　End Sub
　　　关闭该模块。
　　如果你从未创建过类模块，那么你就要认真对待，clsExcelWork是一
个简单的类，工作一点儿也不困难。增加一个新的模块到项目中，并将之
命名为clsExcelWork，同时在声明段中加入该类（列表2）。
　　列表2： clsExcelWork—增加新的类模块到项目中，然后在声明段中
加入新类的代码。
　　　Option Explict
　　　Private xlsheetname As Excel.Worksheet
　　　Private xlobj As Excel.Workbook
　　　Private ExcelWasNotRunning As Boolean
　　　Private Declare Function FindWindow Lib "user32" Alias
　　　"FindWindowA" (ByVal lpClassName As String , ByVal _
　　　lpWindowName As Long) As Long
　　　Private Declare Function SendMessage Lib "user32" Alias _
　　　"SendMessageA (ByVal hwnd As Long , ByVal wMsg As Long , _
　　　ByVal wParam As Long , ByVal lParam As Long ) As Long
　　创建下述方法：
　　　Public Sub RunDLL()
　　　'called from the ActiveX container . this is the only
　　　'public method .
　　　frmMain.Show
　　　End Sub
　　　Friend Sub LoadListboxWithTables()
　　　'Loads the listbox on the form with the name of five
　　　'tables from the Northwind database.
　　　With frmMain.lstTables
　　. AddItem "Categories"
　　. AddItem "Customers"
　　. AddItem "Employees"
　　. AddItem "Products"
　　. AddItem "Suppliers"
　　　End With
　　　End Sub
　　　Private Sub GetExcel()
　　　Dim ws
　　　Set xlobj = GetObject ( App.Path & "\DLLTest.xls")
　　　Xlobj.Windows("DLLTest.xls").visible = True
　　　If Err.Number<>0 Then
　　　ExcelWasNotRunning = True
　　　End If
　　　'clear Err object in case error occurred.
　　　Err.Clear
　　　'Check for Microsoft Excel . If Microsoft Excel is running ,
　　　'enter it into the running Object table.
　　　DetectExcel
　　　'Clear the old worksheets in the workbook .
　　　xlobj.Application.DisplayAlerts = False
　　　For Each ws In xlobj.Worksheets
　　　If ws.Name<>"Sheet1" Then
　　　Ws.Delete
　　　End If
　　　Next
　　　xlobj.Application.DisplayAlerts = True
　　　End Sub
　　　Private Sub DetectExcel()
　　　Const WM_USER =1024
　　　Dim hwnd As Long
　　　'If Excel is running , this API call return its handle .
　　　hwnd = FindWindow("XLMAIN",0)
　　　'0 means Excel isn't running .
　　　If hwnd = 0 Then
　　　Exit sub
　　　Else
　　　'Excel is running so use the SendMessage API function to
　　　'enter it in the Running Object Table .
　　　SendMessge hwnd , WM_USER + 18 , 0 ,0
　　　End If
　　　End Sub
　　　Friend Sub CreateWorksheet()
　　　Dim strJetConnString As String
　　　Dim strJetSQL As String
　　　Dim strJetDB As String
　　　'Prepare Excel worksheet for the Querytable .
　　　GetExcel
　　　xlobj.Worksheets.Add
　　　xlSheetName = xlobj.ActiveSheet.Name
　　　xlobj.Windows("DLLTest.xls").Activate
　　　'Modify strJetDB to point to your installation of
　　　'Northwind.mdb.
　　　strJetDB = "c:\Program Files\Microsoft_
　　　Office\Office\Samples\Northwind.mdb"
　　　'Create a connection string.
　　　strJetConnString = "ODBC;"&"DBQ="&strJetDb&";"& _
　　　"Driver={Microsoft Access Driver (*.mdb")};"
　　　'Create the SQL string
　　　strJetSQL = "SELECT * FROM " & frmMain.lstTables.Text
　　　'Create the QueryTable and populate the worksheet .
　　　With xlobj.Worksheets(xlSheetName).QueryTables. _
　　　Add(connection := strJetConnString, _
　　　Destination := xlobj.Worksheets(xlSheetName).Range("A1") _
　　　SQL := strJetSQL)
　 .　refresh(False)
　　　End With
　　　End Sub


--
问：生活为什么如此美好？
答：因为有了BBS.

※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: che.hit.edu.cn]