VBA实战技巧32：安装Excel加载宏

我们知道，有多种方法可以进入“Excel加载宏”对话框。最简单的就是，单击功能区“开发工具”选项卡“加载项”组中的“Excel加载项”，即可打开如下图1所示的的“加载宏”对话框。

图1

复杂一点的方法就是，单击Excel左上角的“文件——选项”，在“Excel选项”对话框中，单击左侧的“加载项”选项卡，在右侧下方的“管理”下拉列表中选择“Excel加载项”，单击其右侧的“转到”按钮，即可打开上图1所示的“加载宏”对话框。

这两种方法的操作演示如下图2所示。

图2

如果你的加载宏不在“可用加载宏”列表中，则必须单击该对话框右侧的“浏览”按钮，进行查找，然后将其添加到可用加载宏列表中。

Excel是如何管理加载宏列表的

在后台，Excel使用注册表和一个特殊文件夹来管理存在哪些加载项以及已安装了哪些加载项。

为了构建在对话框中的列表，Excel会查看以下几个位置：

1.Add-ins文件夹

C:\Users\[用户名]BHTHP\AppData\Roaming\Microsoft\AddIns

或者：

C:\Program Files\Microsoft Office\Office16\Library

在“加载宏”对话框中会包含这些文件夹中的加载宏。

2.注册表

对于与上述位置不同的加载项，Excel将在注册表中查找。当单击“浏览”按钮以查找加载项时，会在此处添加键。

HKEY_CURRENT_USER\Software\Microsoft\Office\XX.0\Excel\Add-inManager

在此位置，浏览的每个加载项都有一个值。所需的值只是加载项的路径及其名称，如下图3所示。

图3

选择了哪些加载宏

在注册表的另一个位置，Excel会记录选择了哪些加载项（在加载项对话框中检查）。在注册表的以下部分查看：

HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Excel\Options

对于每个选定的加载项，Excel在该位置添加一个条目，依次称为“OPEN”、“OPEN1”、“OPEN2”、……如下图4所示。

图4

每个键都包含要打开的加载项的名称（有时还包含一些命令行参数）。如果加载项不在加载项文件夹中，则包含完整路径。

注意，这些注册表项在关闭Excel后更新。

如何使用VBA来安装Excel加载宏

编写一些简单的代码来启用加载项，弹出的消息框如下图5所示。

图5

下面的VBA代码触发这个消息框：

Option Private Module

Const GCSAPPREGKEY As String ="DemoAddInInstallingItself"

Const GCSAPPNAME As String ="DemoAddInInstallingItself"

Public Function IsInstalled() As Boolean

Dim oAddIn As AddIn

On Error Resume Next

If ThisWorkbook.IsAddin Then

For Each oAddIn In Application.AddIns

If LCase(oAddIn.FullName) <> LCase(ThisWorkbook.FullName) Then

Else

If oAddIn.Installed Then

IsInstalled = True

Exit Function

End If

End If

Next

Else

IsInstalled = True

End If

End Function

Public Sub CheckInstall()

Dim oAddIn As AddIn

If GetSetting(GCSAPPREGKEY, "Settings", "PromptToInstall","") = "" Then

If Not IsInstalled Then

If ThisWorkbook.Path Like Environ("TEMP") & "*"Or InStr(LCase(ThisWorkbook.Path), ".zip") > 0 Then

MsgBox "似乎是从压缩文件夹（zip文件）或临时文件夹中打开加载项的."& vbNewLine & _

vbNewLine &vbNewLine & _

"建议你将加载项文件保存到文档文件夹中的专用文件夹中," & vbNewLine & _

"然后从该位置打开加载项."& vbNewLine & vbNewLine & _

"该加载项现在将关闭.",vbExclamation + vbOKOnly, GCSAPPNAME

ThisWorkbook.Close False

End If

If MsgBox("你愿意安装'" & GCSAPPNAME & "' 作为加载项吗?",vbQuestion + vbYesNo, GCSAPPNAME) = vbYes Then

If ActiveWorkbook Is Nothing Then AddEmptyBook

Set oAddIn = Application.AddIns.Add(ThisWorkbook.FullName, False)

oAddIn.Installed = True

RemoveEmptyBooks

ElseIf MsgBox("你想要停止询问这个问题吗?",vbQuestion + vbYesNo, GCSAPPNAME) = vbYes Then

SaveSetting GCSAPPREGKEY, "Settings","PromptToInstall", "No"

End If

End If

End If

End Sub

这里的关键函数名为“CheckInstall”。

该程序所做的第一件事是找出注册表的“Settings”部分中是否存在名为“PromptToInstall”的注册表项。如果有，则不会提示安装。这样做是为了避免惹烦那些习惯于只在需要时打开加载项的人。

接下来它调用IsInstalled函数，该函数检查是否已安装加载项。

然后，有两个关于插件文件存储位置的检查。如果用户直接打开压缩文件（zip文件）下载，然后打开加载项，则xlam文件将存储在临时位置（如果安装了解压缩软件），或者位于名称中包含.zip的文件夹中。Excel可以打开此类文件，但无法安装zip文件夹中的加载项。并且压缩软件会在关闭后立即删除Temp中的该文件夹。然后，会在Excel中得到一个指向已安装加载项的指针，该加载项没有随附的xlam文件。每次Excel启动时，都会弹出一个找不到加载项的警告消息框，如下图6所示。

图6

因此，为什么代码会显示一个如下图7所示的消息框。

图7

如果一切顺利并且用户首先解压了zip文件，则代码会询问用户是否要安装加载项，如上图5所示。

如果单击“是”按钮，则运行下面的代码来安装加载宏：

If ActiveWorkbook Is Nothing Then AddEmptyBook

Set oAddIn =Application.AddIns.Add(ThisWorkbook.FullName, False)

oAddIn.Installed = True

RemoveEmptyBooks

第一行代码确保在Excel中至少打开一个工作簿窗口。最后一行关闭加载项打开的所有工作簿。为什么？因为当没有活动工作簿时你无法打开加载项对话框，显然这也会阻止Excel通过VBA将新加载项添加到列表中。

如果单击“否”，则会弹出另一个对话框，询问用户是否希望继续询问有关安装加载项的问题，如下图8所示。

图8

如果单击“是”，代码会存储该响应值，因此不会再次打扰用户。

下面是添加一个空工作簿并再次删除它的代码：

Option Private Module

Dim moWB As Workbook

Sub AddEmptyBook()

'如果需要添加一个空工作簿.

If ActiveWorkbook Is Nothing Then

Workbooks.Add

Set moWB = ActiveWorkbook

moWB.CustomDocumentProperties.Add "MyEmptyWorkbook", False, msoPropertyTypeString,"这是由 "& GCSAPPNAME & " 添加的临时工作簿."

moWB.Saved = True

End If

End Sub

Sub RemoveEmptyBooks()

Dim oWb As Workbook

For Each oWb In Workbooks

If IsIn(oWb.CustomDocumentProperties, "MyEmptyWorkbook") Then

oWb.Close False

EndIf

Next

End Sub

Function IsIn(col As Variant, name As String) As Boolean

Dim obj As Object

On Error Resume Next

Set obj =col(name)

IsIn =(Err.Number = 0)

End Function

触发安装

使这一切正常工作的最后一点是，确保在打开加载宏时调用CheckInstall过程。代码在ThisWorkbook 模块中：

Private Sub Workbook_Open()

CheckInstall

End Sub

如果直接从Workbook_Open事件调用过程，某些Excel用户会遇到问题。在这种情况下，使用Application.Ontime启动所需的过程。使用OnTime方法使Excel有时间在启动安装过程之前执行其所有启动的一些工作：

Private Sub Workbook_Open()

Application.OnTimeNow, "'" & ThisWorkbook.FullName & "'!CheckInstall"

End Sub