创建ActiveX接口以移植Excel工作表

利用Visual Basic 5.0中的ActiveX DLL移植Excel工作表中的Access数据，本技术将避免应用程序修改后所需要的发布工作。

你可曾想过移植Excel工作表中的数据，但是对那些用户来说却不会感觉到工作的复杂？你是否想开发具有报告列表的用户接口，从而使你能够插入Excel工作簿？另外，你是否能够以这样一种方式开发用户接口，即当该接口发生变化时，用户的机器能够自动更新到最新版本？本文将向你展示怎样建立：

• Visual Basic 5.0中的简单ActiveX DLL，从而使用户从Northwind数据库中获得一系列表单。只要选择表单，就可以移植包含Access数据的Excel工作表。
• Excel工作表，该表包含菜单项的定制代码，从而初始化ActiveX DLL。
• 可执行程序，该程序可以发送上述工作簿，并可检查公用资源中ActiveX DLL的新版本，如果发现存在新版本，则拷贝并注册该DLL到用户的机器。

该方法的优点

我因为以下几个原因而喜欢该方法。一旦ActiveX DLL编译成功，它可以被任何ActiveX的兼容宿主程序调用，这意味着你能够在Microsoft Word、Internet Explorer或者大量的应用程序中使用它们。

不同于 Excel中的VBA编码，那些DLL一旦编译成功就再也不能为用户所修改，如果你想做一些与Excel相似的工作，就必须创建并发布相应的附加项。正如前面讨论的那样，只要进行简单的Visual Basic编程，用户机器上的DLL就能够轻易地被替换。这意味着一旦故障被发现，或者新版本开发成功，用户就可以直接升级，而再也不必经受安装整个应用程序的痛苦。

该方法的不足

最大的不足是需要在兼容宿主程序上调用该ActiveX DLL，如果你要移植Excel工作表或Word文档，那将不成问题。如果你要在自己编制的可执行程序或不可视的兼容宿主程序上调用该DLL，那么控制将变得比较困难，换句话说，此时采用标准的可执行程序作为接口是不适合的，最好的方法是为另一个应用程序提供接口。

设计DLL

为了创建接口，打开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 Explicit
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 FilesMicrosoft OfficeOfficeSamplesNorthwind.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