| | | 创建ActiveX接口以移植Excel工作表 | | 2001-09-18·
·--··vbeden
| 上一页 1 2 3 4
设计启动程序
需要冷静思考的是，用户是否需要打开特定的Excel工作表以访问该接口？如果你需要改变用户的接口时将会发生什么？你是否需要重新编制安装文件，是否需要与每一个用户取得联系，并使他们重新安装相应的应用程序，把ActiveX DLL自动地拷贝和注册到用户的机器上是否是一种好的方法？
可执行程序能够检查DLL而且在需要的时候更新并注册DLL，接着继续发送Execl并打开你所创建的工作簿，幸运的是，这是一种相当直接的过程。开始创建一个新个Visual basic项目并将之命名为RunExcelDLL,并删除缺省的Form，再增加一个新模块到basMain。增加下列代码到模块的声明段：
Option Explicit
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 RegMyServerObject Lib _
"ExcelDll.dll" Alias "DllRegisterServer" () As Long
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long , ByVal _
LpszOp As String , ByVal lpszFile As String , ByVal _
LpszParams As String , ByVal lpszFile As String , ByVal _
FsShowCmd As Long ) As Long
增加列表4的代码到模块中。
列表4：编制启动程序--在模块中添加下列代码。
Private Function RegisterDLL() As Boolean
On Error GoTo Err_DLL_Not_Registered
Dim RegMyDLLAttempted As Boolean
‘Attempt to register the DLL.
RegMyServerObject
RegisterDLL = True
Exit Function
Err_DLL_Not_Registered:
‘Check to see if error 429 occurs .
If err.Number = 429 Then
‘RegMyDLLAttempted is used to determine whether an
‘attempt to register the ActiveX DLL has already been
‘attempted. This helps to avoid getting stuck in a loop if
‘the ActiveX DLL cannot be registered for some reason .
RegMyDLLAttempeted = True
MsgBox " The new version of ExcelDll could not be _
Registered on your system! This application will now _
terminate. ", vbCritical, "Fatal Error"
Else
MsgBox "The new version of ExcelDLL could not be _
Registered on your system. This may occur if the DLL _
is loaded into memory. This application will now _
terminate . It is recommended that you restart your _
computer and retry this operation.", vbCritical, _ "Fatal Error".
End If
RegisterDLL = False
End Function
Sub Main()
Dim x
If UpdateDLL = True Then
DoShellExecute (App.Path & "\DLLTest.xls")
‘ frmODBCLogon.Show vbModal
Else
MsgBox "The application could not be started !", _
VbCritical , "Error"
End If
End
End Sub
Sub DoShellExecute(strAppPAth As String)
On Error GoTO CodeError
Dim res
Dim obj As Object
res = ShellExecute(0, "Open", strAppPath, _
VbNullString, CurDir$, 1)
If res<32 Then
MsgBox "Unable to open DllTest application"
End If
CodeExit
Exit Sub
CodeError:
Megbox "The following error occurred in the procedure " & _
StrCodeName & Chr(13) & err.Number & " " & _
Err.Description, vbOKOnly, "Error Occurred"
GoTo CodeExit
End Sub
Function UpdateDLL() As Boolean
On Error GoTO err
Dim regfile
If CDate(FileDateTime(App.Path & "\Excel.dll")) <_
CDate(FileDateTime("C:\Temp\ExcelDLL.dll")) Then
If DetectExcel = True Then
MsgBox "Your version of ExcelDll needs to be updated, _
but Microsoft Excel is running. Please close Excel and _
restart this application so all files can be _
Replaced", vbOK, "Close Excel"
End
End If
If MsgBox("your version of ExcelDll is out of date, _
If you click on OK it will be replaced with the newest _
Version. Otherwise the application will terminate", _
VbOKCancel, "Replace Version?") = vbCancel Then
End
End If
If Dir(App.Path & "\ExcelDll.dll") > "" _
Then Kill App.Path & "\ExcelDll.dll"
FileCopy "c:\Temp\ExcelDll.dll", _
App.Path & "\ExcelDll.dll "
If RegisterDLL = True Then
UpdateDLL = True
Exit Function
Else
UpdateDLL = False
Exit Function
End If
Else
UpdateDLL = True
End If
Exit Function
err:
MegBox "The error " & err.Number & "" & _
err.Description & "occurred"
UpdateDLL =False
End Function
Private Function DetectExcel() As Boolean
‘ Procedure detects a running Excel and registers it.
Const WM_USER = 1024
Dim hwnd As Long
'If Excel is running, this API call returns its handle.
hwnd = FindWindow("XLMAIN", 0)
If hwnd = 0 Then ‘0 means Excel not running.
DetectExcel = False
Else
DetectExcel = True
End If
End Function
|
上一页 1 2 3 4 | | | 感谢
访问天极网，如果您觉得该文章涉及版权问题，请看这里！
|
|
