在加载宏及其源文件之间切换 - 成就云开发者社区

标签：VBA，加载宏

在“.xlsm”文件及其转换为的加载项文件“.xlam”之间来回切换并不是一件很容易的事。下面是www.wimgielis.com中提供的一个示例，在Personal.xlsb（个人宏工作簿）中，还添加了五个过程在xlsm版本（主要用于开发）和xlam版本（主要用来测试和使用）之间切换：

Addin_SAVE_AS：将xlsm保存为xlam，不再打开xlsm版本
Addin_INSTALLED：安装xlam版本，不再打开xlsm版本
Addin_NO_Addin：卸载xlam版本，xlsm版本也不再打开
Addin_UNINSTALLED：卸载xlam版本，将打开xlsm版本
Addin_TOGGLE_VISIILITY：使xlam版本可见或不可见

可以在原网站搜索并下载示例代码工作簿。

也可以在完美Excel微信公众号中发送消息：

切换加载宏

获取示例代码工作簿的下载链接。

或者，直接到知识星球App完美Excel社群中下载示例代码工作簿。

下面是4个程序代码：

代码语言：javascript

复制

Const Addin_FileName As String = "Menu_Test.xlsm"
' 在文件及其加载项对应文件之间切换的过程
Sub Addin__SAVE_AS()
' 目的:
' - 将当前工作簿保存为加载宏
 On Error Resume Next
 Dim o                     As Object
 Dim sFileName_Addin       As String
 Set o = CreateObject("scripting.filesystemobject")
 Application.DisplayAlerts = False
 With ActiveWorkbook
   If .Name <> Addin_FileName Then MsgBox "保存文件错误" : Exit Sub
   .Save
   Select Case
    o.GetExtensionName(.FullName)
   Case "xls"
     sExtension = "xla"
     lExtension = 18
   Case "xlsx", "xlsm"
     sExtension = "xlam"
     lExtension = 55
   Case Else
     lExtension = 0
   End Select
   sFileName_Addin = Application.UserLibraryPath & o.GetBaseName(.FullName) & "." & sExtension
   If CDbl(CDate(FileDateTime(.FullName))) < CDbl(CDate(FileDateTime(sFileName_Addin))) Then
     '加载项文件比源文件更新
     If MsgBox("加载项文件比源文件更新. 你想继续吗?", vbYesNoCancel) <> vbYes Then
       GoTo LastSteps
     End If
   End If
   Addin_UNINSTALLED
   .SaveAs Filename:=sFileName_Addin, FileFormat:=lExtension, CreateBackup:=False
 End With
LastSteps:
 Application.DisplayAlerts = True
 On Error GoTo 0
 Addin_INSTALLED
End Sub
Sub Addin_INSTALLED()

' 目的:

' - 安装加载宏

' - 关闭基础的xlsm文件

On Error Resume Next

Workbooks(Addin_FileName).Close True

On Error GoTo 0

With AddIns(CreateObject("Scripting.FileSystemObject").GetBaseName(Application.UserLibraryPath & Addin_FileName))

If Not .Installed Then .Installed = True

End With

If Workbooks.Count <= 1 Then Workbooks.Add

End Sub
Sub Addin_UNINSTALLED()

' 目的:

' - 卸载加载宏

' - 打开基础的xlsm文件

With AddIns(CreateObject("Scripting.FileSystemObject").GetBaseName(Application.UserLibraryPath & Addin_FileName))

If .Installed Then .Installed = False

End With

On Error Resume Next

If Workbooks(Addin_FileName) Is Nothing Then

Workbooks.Open

Application.UserLibraryPath & Addin_FileName

End If

On Error GoTo 0

End Sub
Sub Addin_TOGGLE_VISIBILITY()

' 目的:

' - 允许加载宏可见

'更改.IsAddin属性

On Error Resume Next

With Workbooks(AddIns(CreateObject("Scripting.FileSystemObject").GetBaseName(Application.UserLibraryPath & Addin_FileName)).Name)

.IsAddin = Not .IsAddin

End With

On Error GoTo 0

End Sub
Sub Addin_NO_ADDIN()

' 目的:

' - 卸载加载宏

' - 关闭基础的xlsm文件

With AddIns(CreateObject("Scripting.FileSystemObject").GetBaseName(Application.UserLibraryPath & Addin_FileName))

If .Installed Then .Installed = False

End With

On Error Resume Next
If Not Workbooks(Addin_FileName) Is Nothing Then

Workbooks(Addin_FileName).Close

End If

On Error GoTo 0

End Sub

最后补充一点，这两个文件（xlsm和xlam）都存储在加载宏的默认文件夹中。

欢迎在下面留言，完善本文内容，让更多的人学到更完美的知识。