excelperfect
下面的程序整理自jkp-ads.com，使用VBA代碼來自動安裝或者移除指定的加載宏。
Dim vReply As Variant
Dim AddInLibPath As String
Dim CurAddInPath As String
'修改為你想要安裝的加載宏名稱
Const sAppName As String = '完美Excel'
Const sFilename As String = sAppName &'.xlam'
'用于設置的注冊表鍵
Const sRegKey As String = 'FXLNameMgr'
'安裝加載宏
Sub Setup()
vReply =MsgBox('這將安裝 '& sAppName & vbNewLine & _
'到你的默認加載項文件夾.'& vbNewLine & vbNewLine & '繼續(xù)?', vbYesNo, sAppName &' 安裝')
If vReply= vbYes Then
On Error Resume Next
Workbooks(sFilename).Close False
If Application.OperatingSystem Like '*Win*' Then
CurAddInPath = ThisWorkbook.Path & '\' & sFilename
If Right(Application.UserLibraryPath, 1) <>Application.PathSeparator Then
AddInLibPath =Application.UserLibraryPath & '\' & sFilename
Else
AddInLibPath = Application.UserLibraryPath & sFilename
End If
Else
CurAddInPath = ThisWorkbook.Path & ':' & sFilename
'語法與Win不同
AddInLibPath = Application.UserLibraryPath & sFilename
End If
On Error Resume Next
FileCopy CurAddInPath, AddInLibPath
If Err.Number <> 0 Then
SomeThingWrong
Exit Sub
End If
With AddIns.Add(FileName:=AddInLibPath)
.Installed = True
End With
Else
vReply =MsgBox(prompt:='安裝已取消',Buttons:=vbOKOnly, Title:=sAppName & ' 安裝')
End If
End Sub
'錯誤信息
Sub SomeThingWrong()
If Application.OperatingSystemLike '*Win*' Then
vReply = MsgBox(prompt:='在加載宏復制到加載項文件夾期間' &vbNewLine _
&'發(fā)生錯誤:'_
&vbNewLine & vbNewLine & Application.UserLibraryPath _
&vbNewLine & vbNewLine & '你可以通過手動復制文件 ' &sFilename & ' 安裝加載宏'_
&vbNewLine & sAppName & ' 到你的目錄中并使用Excel功能區(qū)中的加載項工具安裝該加載宏.'_
&vbNewLine & vbNewLine & '不要按''''確定'''',首先從Windows資源管理器中復制.'_
&vbNewLine & '它使你有機會按ALT+TAB返回Excel以閱讀此文本.'_
&vbNewLine, Buttons:=vbOKOnly, Title:=sAppName & ' 安裝')
Else
vReply = MsgBox(prompt:='在該加載宏復制到你的加載項目錄期間發(fā)生錯誤:'& vbNewLine _
&vbNewLine & vbNewLine & Application.UserLibraryPath _
&vbNewLine & vbNewLine & '你可以通過復制 ' &sFilename & ' 手動安裝加載項 '_
&vbNewLine & sAppName & ' 到這個目標并使用Excel功能區(qū)中的加載項工具安裝該加載宏.'_
&vbNewLine & vbNewLine & '先不要按''''確定'''',先在Finder中復制.' _
&vbNewLine & '它使你有機會按ALT+TAB返回Excel以閱讀此文本.'_
&vbNewLine, Buttons:=vbOKOnly, Title:=sAppName & ' 安裝')
End If
End Sub
'移除加載宏
Sub Uninstall()
vReply =MsgBox('這將從系統(tǒng)中移除加載宏 '& sAppName & vbNewLine & _
vbNewLine& vbNewLine & '繼續(xù)?',vbYesNo, sAppName & ' 安裝')
If vReply= vbYes Then
If Application.OperatingSystem Like '*Win*' Then
CurAddInPath = ThisWorkbook.Path & '\' & sFilename
If Right(Application.UserLibraryPath, 1) <>Application.PathSeparator Then
AddInLibPath = Application.UserLibraryPath & '\' &sFilename
Else
AddInLibPath = Application.UserLibraryPath & sFilename
End If
Else
CurAddInPath = ThisWorkbook.Path & ':' & sFilename
AddInLibPath = Application.UserLibraryPath & sFilename
End If
On Error Resume Next
Workbooks(sFilename).Close False
Kill AddInLibPath
DeleteSetting sRegKey
MsgBox '這個 '& sAppName & ' 已經從你的計算機中移除.'_
&vbNewLine & '為了完成移除操作, 請在對話框中選取 '& sAppName _
&vbNewLine & ' 并確認刪除',vbInformation + vbOKOnly
Application.CommandBars(1).FindControl(ID:=943,recursive:=True).Execute
End If
End Sub
注意，包含本代碼的工作簿應與加載宏文件放置在同一文件夾中。在移除加載宏時，會彈出“加載宏”對話框，需要手動取消相應加載宏前面的復選，才能徹底移除該加載宏。
