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

利用VisualBasic5.0中的ActiveXDLL移植Excel工作表中的Access数据，本技术将避免应用程序修改后所需要的发布工作。

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

VisualBasic5.0中的简单ActiveXDLL，从而使用户从Northwind数据库中获得一系列表单。只要选择表单，就可以移植包含Access数据的Excel工作表。
Excel工作表，该表包含菜单项的定制代码，从而初始化ActiveXDLL。
可执行程序，该程序可以发送上述工作簿，并可检查公用资源中ActiveXDLL的新版本，如果发现存在新版本，则拷贝并注册该DLL到用户的机器。
该方法的优点
我因为以下几个原因而喜欢该方法。一旦ActiveXDLL编译成功，它可以被任何ActiveX的兼容宿主程序调用，这意味着你能够在MicrosoftWord、InternetExplorer或者大量的应用程序中使用它们。

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

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

设计DLL
为了创建接口，打开VisualBasic并创建一个标准的可执行项目，并将他存储在你所选定的ExcelDLL文件夹中。为了加入Excel引用，点击Project>References和MicrosoftExcel8.0ObjectLibrary。双击ProjectExplorer中的缺省Form，并将之重新命名为frmMain，设定Form的标题为OpenNorthwindTables，并且增加具有下列属性的控件：

为了创建Access数据库和Excel电子表格之间的接口，增加列表1的代码到Form中。

列表1：设计DLL,增加这些代码到Form中以创建接口。

'Declarethenewclass
Dimmcls_clsExcelWorkAsNewclsExcelWork

PrivateSubcmdOpenTable_Click()
'calltheCreateWorksheetmethodoftheclsExcelWork
'class.
mcls_clsExcelWork.CreateWorksheet
EndSub

PrivateSubForm_Load()
'calltheLoadListboxWithTablesmethod.mcsl_clsExcelWork.LoadListboxWithTables
EndSub

PrivateSubForm_Unload(CancelAsInteger)
Setmcls_clsExcelWork=Nothing
EndSub

PrivateSublstTables_DblClick()
Mcls_clsExcelWork.CreateWorksheet
EndSub
增加标准的模块到项目中，并将下列代码加入到该模块中：

SubMain()
EndSub
关闭该模块。

如果你从未创建过类模块，那么你就要认真对待，clsExcelWork是一个简单的类，工作一点儿也不困难。增加一个新的模块到项目中，并将之命名为clsExcelWork，同时在声明段中加入该类（列表2）。

列表2：clsExcelWork-增加新的类模块到项目中，然后在声明段中加入新类的代码。

OptionExplicit
PrivatexlsheetnameAsExcel.Worksheet

PrivatexlobjAsExcel.Workbook
PrivateExcelWasNotRunningAsBoolean

PrivateDeclareFunctionFindWindowLib"user32"Alias_
　　　　"FindWindowA"(ByVallpClassNameAsString,ByVal_
　　　　lpWindowNameAsLong)AsLong

PrivateDeclareFunctionSendMessageLib"user32"Alias_
　　　　"SendMessageA"(ByValhwndAsLong,ByValwMsgAsLong,_
　　　　ByValwParamAsLong,ByVallParamAsLong)AsLong
创建下述方法：

PublicSubRunDLL()
'calledfromtheActiveXcontainer.
'thisistheonlypublicmethod.
frmMain.Show
EndSub

FriendSubLoadListboxWithTables()
'Loadsthelistboxontheformwiththenameof'fivetablesfromtheNorthwinddatabase.
WithfrmMain.lstTables
.AddItem"Categories"
.AddItem"Customers"
.AddItem"Employees"
.AddItem"Products"
.AddItem"Suppliers"
EndWith
EndSub

PrivateSubGetExcel()
Dimws

Setxlobj=GetObject(App.Path&"\DLLTest.xls")
xlobj.Windows("DLLTest.xls").Visible=True

IfErr.Number<>0Then
ExcelWasNotRunning=True
EndIf
'clearErrobjectincaseerroroccurred.
Err.Clear

'CheckforMicrosoftExcel.IfMicrosoftExcelisrunning,
'enteritintotherunningObjecttable.

DetectExcel

'Cleartheoldworksheetsintheworkbook.
xlobj.Application.DisplayAlerts=False

ForEachwsInxlobj.Worksheets
Ifws.Name<>"Sheet1"Then
ws.Delete
EndIf
Next

xlobj.Application.DisplayAlerts=True
EndSub

PrivateSubDetectExcel()
ConstWM_USER=1024
DimhwndAsLong
'IfExcelisrunning,thisAPIcallreturnitshandle.
hwnd=FindWindow("XLMAIN",0)
'0meansExcelisn'trunning.
Ifhwnd=0Then
ExitSub
Else'ExcelisrunningsousetheSendMessageAPIfunctionto
'enteritintheRunningObjectTable.
SendMessgehwnd,WM_USER 18,0,0
EndIf
EndSub

FriendSubCreateWorksheet()
DimstrJetConnStringAsString
DimstrJetSQLAsString
DimstrJetDBAsString
'PrepareExcelworksheetfortheQuerytable.
GetExcel
xlobj.Worksheets.Add
xlsheetname=xlobj.ActiveSheet.Name
xlobj.Windows("DLLTest.xls").Activate
'ModifystrJetDBtopointtoyourinstallationofNorthwind.mdb.
strJetDB="c:\ProgramFiles\MicrosoftOffice\Office\Samples\Northwind.mdb"

'Createaconnectionstring.
strJetConnString="ODBC;"&"DBQ="&strJetDB&";"&_
"Driver={MicrosoftAccessDriver(*.mdb)};"

'CreatetheSQLstring
strJetSQL="SELECT*FROM"&frmMain.lstTables.Text
'CreatetheQueryTableandpopulatetheworksheet.
Withxlobj.Worksheets(xlsheetname).QueryTables.Add(Connection:=strJetConnString,_
Destination:=xlobj.Worksheets(xlsheetname)_
.Range("A1"),Sql:=strJetSQL)
.Refresh(False)
EndWith
EndSub->