在加载宏及其源文件之间切换

标签：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）都存储在加载宏的默认文件夹中。

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

基础 存储 error 测试 工作

0 人点赞