我有两个Excel文件,parent和child,其中child包含父函数使用的函数库。出于版本控制的目的,我将它们保存在同一个文件夹中,并将文件夹复制并重命名为完全相同的位置以跟踪我的版本。我还希望动态更新引用,以便当我移动到新版本时,父级始终指向同一位置的子级。
所以为了实现这个目的,我在父母中实现了两个例程。
一,在ThisWorkbook中,我使用了Workbook_Open sub:
Private Sub Workbook_Open()
'Force the location of the shared library to the current project folder irrespective where the project is located
Call reloadSharedLibrary
End Sub
二,在Modules.Libraries中我添加了另一个sub reloadSharedLibrary:
Public librName As Variant
Public isRefReloaded As Boolean
Sub reloadSharedLibrary()
isRefReloaded = True
Dim VBAEditor As VBIDE.VBE
Dim vbProj As VBIDE.VBProject
Dim chkRef As VBIDE.Reference
Dim BoolExists As Boolean
Dim librPath As String
Set VBAEditor = Application.VBE
Set vbProj = ActiveWorkbook.VBProject
librName = "lib_emtm"
librPath = Application.ActiveWorkbook.Path & "\lib.xlsm"
' delete any shared lib (if exists)
For Each chkRef In vbProj.References
If chkRef.Name = librName Then
vbProj.References.Remove chkRef
BoolExists = True
End If
Next
' you can only add it to VBAProject only after you quit the above loop
On Error Resume Next
vbProj.References.AddFromFile librPath
If Err.Number <> 0 Then
MsgBox "FATAR ERROR: Cannot find shared library file in project root": End
End If
Set vbProj = Nothing
Set VBAEditor = Nothing
End Sub
现在,问题在于,当我将项目文件夹复制到新版本文件夹时,对子项的引用不会更新。版本使用的子版本来自旧版本。
我做错了什么?
答案 0 :(得分:1)
问题是,当VBA项目加载文档及其引用时,它会为它们指定一个名称,在您的情况下为lib_emtm
。取消选中对它的引用时,将从VBA项目中删除引用,但项目编辑器会将名称保留在其缓存中。此名称将保留在缓存中,直到您关闭工作簿并重新打开它。
您可以在项目参考菜单中对此进行验证:即使您取消选中参考,您也会看到库lib_emtm
的名称仍会显示在那里。
然后,当您尝试添加对“其他”子工作簿(同一文件夹中的工作簿)的引用时,编辑器将发现名称为lib_emtm
,该名称与缓存中的名称相同,所以不是打开新文档并解析它,而是使用缓存版本,这是旧文档!
如果您关闭然后重新打开应用程序,则库的名称将从缓存中消失,因此您可以安装正确的版本。要完成此模式,仅在引用其他工作簿时才会出现,而不是在系统上安装常规DLL
。
我尝试了但是在重新安装之前找不到VBA方法从编辑器的缓存中删除Cached library
。如果有人找到了完成解决方案的方法。因此,在重新打开文档并安装lib之前,我们必须关闭文档。这个过程可能是自动化的,但我建议一个解决方案,提示用户。
' Module ThisWorkbook
Option Explicit
Private Sub Workbook_Open()
'Force the location of the shared library to the current project folder irrespective where the project is located
Dim check As Boolean: check = checkSharedLibrary
If check Then Exit Sub
Dim prompt
prompt = MsgBox("The installed lib_emtm library was uninstalled because it was not the correct version." & vbCrLf & _
"If you click Ok, document will close and the correct version will be automatically installed when you reopen it." & vbCrLf & _
"If you click Cancel, library will not be available in this session but will be installed next time you open the document", vbOKCancel)
If prompt = vbOK Then ThisWorkbook.Close True
End Sub
' Regular module
Option Explicit
Private librName As String, librpath As String
' if correct version already installed (correct path) return true
' if library installed with incorrect version, uninstall it and return false
' if library not installed, install it and return true
Public Function checkSharedLibrary() As Boolean
librName = "lib_emtm"
librpath = ThisWorkbook.Path & "\lib_emtm.xlsm"
Dim chkRef As VBIDE.Reference
For Each chkRef In ThisWorkbook.VBProject.References
If chkRef.name = librName Then Exit For
Next
If chkRef Is Nothing Then
install_emtm
checkSharedLibrary = True
ElseIf Left(chkRef.FullPath, InStrRev(chkRef.FullPath, "\") - 1) = ThisWorkbook.Path Then
checkSharedLibrary = True ' we have the correct version
Else
ThisWorkbook.VBProject.References.Remove chkRef ' return false
End If
End Function
Private Sub install_emtm()
On Error Resume Next
ThisWorkbook.VBProject.References.AddFromFile(librpath)
If Err.Number <> 0 Then MsgBox "FATAR ERROR: Could not install lib_emtm:" & vbCrLf & Err.Description & vbCrLf & vbCrLf & _
"Please verify that the library's file is present in the same folder or try a manual install"
End Sub
最后一点,如果我们直接关闭应用程序但是在此之前我们可以安排重新打开工作簿,则可以在没有用户干预的情况下自动执行该过程。但事情可能会变得复杂,因为用户可能打开了其他Excel文档,所以我们不能强迫她关闭所有内容。