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 & '继续?', 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
注意,包含本代码的工作簿应与加载宏文件放置在同一文件夹中。在移除加载宏时,会弹出“加载宏”对话框,需要手动取消相应加载宏前面的复选,才能彻底移除该加载宏。
联系客服