2012-03-16 155 views
3

我寫了excel VBA加載項文件(.xlam)。我也有一個導出的功能區定製(.exportedUI)。我如何創建安裝程序,以便我的用戶可以運行安裝程序來安裝Excel VBA加載項和功能區定製?自動安裝excel VBA加載項

回答

2

我創建了一個自動安裝過程,將其添加到XLAM文件的「This Workbook」部分,以便它在文件打開時自動運行。 爲了區分安裝文件和安裝的文件,安裝版本命名爲「.install.xlam」,安裝的版本命名爲「.xlam」。 (否則,Excel有一個「對不起,Excel不能同時打開兩個工作簿具有相同的名稱。」

步驟: - 與.install.xlam 重命名XLAM文件 - 在Visual打開並編輯Basic編輯器(VBE) - 添加下列步驟爲「此工作簿」一節中VBE - 保存文件

爲了分享/安裝您的XLAM,你現在只需要要求用戶雙擊XLAM文件,根據需要啓用宏並接受以安裝插件。

如果您想稍後更新您的XLAM o n,只需雙擊它,根據需要啓用宏並拒絕安裝它。然後編輯它並保存更改。

這裏是增加「的ThisWorkbook」的代碼:

‘ (c) Willy Roche (willy.roche(at)centraliens.net) 
‘ Install procedure of XLAM (library of functions) 
‘ This procedure will install a file name .install.xlam in the proper excel directory 
‘ The install package will be name 
‘ During install you may be prompt to enable macros (accept it) 
‘ You can accept to install or refuse (which let you modify the XLAM file macros or install procedure 

Option Explicit 
Const bVerboseMessages = False ‘ Set it to True to be able to Debug install mechanism 
Dim bAlreadyRun As Boolean ‘ Will be use to verify if the procedure has already been run 

Private Sub Workbook_Open() 
‘ This sub will automatically start when xlam file is opened (both install version and installed version) 
Dim oAddIn As Object, oXLApp As Object, oWorkbook As Workbook 
Dim i As Integer 
Dim iAddIn As Integer 
Dim bAlreadyInstalled As Boolean 
Dim sAddInName As String, sAddInFileName As String, sCurrentPath As String, sStandardPath As String 

sCurrentPath = Me.Path & 「\」 
sStandardPath = Application.UserLibraryPath ‘ Should be Environ(「AppData」) & 「\Microsoft\AddIns」 
DebugBox (「Called from:'」 & sCurrentPath & 「‘」) 

If InStr(1, Me.Name, 「.install.xlam」, vbTextCompare) Then 
‘ This is an install version, so let’s pick the proper AddIn name 
sAddInName = Left(Me.Name, InStr(1, Me.Name, 「.install.xlam」, vbTextCompare) – 1) 
sAddInFileName = sAddInName & 「.xlam」 

‘ Avoid the re-entry of script after activating the addin 
If Not (bAlreadyRun) Then 
DebugBox (「Called from:'」 & sCurrentPath & 「‘ bAlreadyRun = false」) 
bAlreadyRun = True ‘ Ensure we won’t install it multiple times (because Excel reopen files after an XLAM installation) 
If MsgBox(「Do you want to install/overwrite ‘」 & sAddInName & 「‘ AddIn ?」, vbYesNo) = vbYes Then 
‘ Create a workbook otherwise, we get into troubles as Application.AddIns may not exist 
Set oXLApp = Application 
Set oWorkbook = oXLApp.Workbooks.Add 
‘ Test if AddIn already installed 
For i = 1 To Me.Application.AddIns.Count 
If Me.Application.AddIns.Item(i).FullName = sStandardPath & sAddInFileName Then 
bAlreadyInstalled = True 
iAddIn = i 
End If 
Next i 
If bAlreadyInstalled Then 
‘ Already installed 
DebugBox (「Called from:'」 & sCurrentPath & 「‘ Already installed」) 
If Me.Application.AddIns.Item(iAddIn).Installed Then 
‘ Deactivate the add-in to be able to overwrite the file 
Me.Application.AddIns.Item(iAddIn).Installed = False 
Me.SaveCopyAs sStandardPath & sAddInFileName 
Me.Application.AddIns.Item(iAddIn).Installed = True 
MsgBox (「‘」 & sAddInName & 「‘ AddIn Overwritten」) 
Else 
Me.SaveCopyAs sStandardPath & sAddInFileName 
Me.Application.AddIns.Item(iAddIn).Installed = True 
MsgBox (「‘」 & sAddInName & 「‘ AddIn Overwritten & Reactivated」) 
End If 
Else 
‘ Not yet installed 
DebugBox (「Called from:'」 & sCurrentPath & 「‘ Not installed」) 
Me.SaveCopyAs sStandardPath & sAddInFileName 
Set oAddIn = oXLApp.AddIns.Add(sStandardPath & sAddInFileName, True) 
oAddIn.Installed = True 
MsgBox (「‘」 & sAddInName & 「‘ AddIn Installed and Activated」) 
End If 
oWorkbook.Close (False) ‘ Close the workbook opened by the install script 
oXLApp.Quit ‘ Close the app opened by the install script 
Set oWorkbook = Nothing ‘ Free memory 
Set oXLApp = Nothing ‘ Free memory 
Me.Close (False) 
End If 
Else 
DebugBox (「Called from:'」 & sCurrentPath & 「‘ Already Run」) 
‘ Already run, so nothing to do 
End If 
Else 
DebugBox (「Called from:'」 & sCurrentPath & 「‘ in place」) 
‘ Already in right place, so nothing to do 
End If 
End Sub 

Sub DebugBox(sText As String) 
If bVerboseMessages Then MsgBox (sText) 
End Sub