VBA实用小程序：使用VBA代码安装或卸载加载宏

下面的程序整理自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 & "继续?", 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 _

&"发生错误:"_

&vbNewLine & vbNewLine & Application.UserLibraryPath _

&vbNewLine & vbNewLine & "你可以通过手动复制文件 " &sFilename & " 安装加载宏"_

&vbNewLine & sAppName & " 到你的目录中并使用Excel功能区中的加载项工具安装该加载宏."_

&vbNewLine & vbNewLine & "不要按""""确定"""",首先从Windows资源管理器中复制."_

&vbNewLine & "它使你有机会按ALT+TAB返回Excel以阅读此文本."_

&vbNewLine, Buttons:=vbOKOnly, Title:=sAppName & " 安装")

Else

vReply = MsgBox(prompt:="在该加载宏复制到你的加载项目录期间发生错误:"& vbNewLine _

&vbNewLine & vbNewLine & Application.UserLibraryPath _

&vbNewLine & vbNewLine & "你可以通过复制 " &sFilename & " 手动安装加载项 "_

&vbNewLine & sAppName & " 到这个目标并使用Excel功能区中的加载项工具安装该加载宏."_

&vbNewLine & vbNewLine & "先不要按""""确定"""",先在Finder中复制." _

&vbNewLine & "它使你有机会按ALT+TAB返回Excel以阅读此文本."_

&vbNewLine, Buttons:=vbOKOnly, Title:=sAppName & " 安装")

End If

End Sub

'移除加载宏

Sub Uninstall()

vReply =MsgBox("这将从系统中移除加载宏 "& sAppName & vbNewLine & _

vbNewLine& vbNewLine & "继续?",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

注意，包含本代码的工作簿应与加载宏文件放置在同一文件夹中。在移除加载宏时，会弹出“加载宏”对话框，需要手动取消相应加载宏前面的复选，才能彻底移除该加载宏。