可以在运行时修改Excel VBA引用(在加载项的运行时加载后)?

时间:2011-08-11 21:53:54

标签: excel vba excel-vba

动态加载Excel 2010加载项时,必须先将VBA引用更改为包含新添加的加载项,然后将其加载到工作簿中。

此代码适用于以编程方式加载加载项:

Function LoadAddin(strFilePath As String) As Boolean
   ' Checks whether add-in is in collection, and
   ' then loads it. To call this procedure, pass
   ' in add-in's path and file name.

   Dim addXL            As Excel.AddIn
   Dim strAddInName     As String

   On Error Resume Next
   ' Call ParsePath function to return file name only.
   'strAddInName = ParsePath(strFilePath, FILE_ONLY)    'not available in VBA...so it seems to always physically load it below, which seems to work fine.
   ' Remove extension from file name to get add-in name.
   strAddInName = Left(strAddInName, Len(strAddInName) - 4)
   ' Attempt to return reference to add-in.
   Set addXL = Excel.AddIns(strAddInName)
   If err <> 0 Then
      err.Clear
      ' If add-in is not in collection, add it.
      Set addXL = Excel.AddIns.Add(strFilePath)
      If err <> 0 Then
         ' If error occurs, exit procedure.
         LoadAddin = False
         GoTo exit_function
      End If
   End If
   ' Load add-in.
   If Not addXL.Installed Then addXL.Installed = True
   LoadAddin = True

exit_function:
   Exit Function
End Function

那么有没有办法将此添加到引用中,因此主机电子表格中引用此新包含的加载项中的VBA的VBA代码将正确执行?

似乎要走的路线可能是:

ThisWorkbook.VBProject.References.AddFromFile ("C:\MyFiles\MyAddin.xlam")

...但这给了我错误:

Microsoft Visual Basic for Applications
Run-time error '32813':
Application-defined or object-defined error

1 个答案:

答案 0 :(得分:0)

您是否考虑在加载项的工作簿打开事件中使用相同的代码(但略有修改)?

如果我理解正确,那么我想这就是你想要的?

Public ShouldIContinue As Boolean

Private Sub Workbook_Open()
    '~~> This is required to avoid the endless loop
    If ShouldIContinue = True Then Exit Sub

    Dim addXL As AddIn
    Dim strAddInName As String
    Dim oTempBk As Workbook

    strFilePath = ThisWorkbook.FullName

    strAddInName = ThisWorkbook.Name
    '~~> This will work for both .xla and .xlam
    strAddInName = Left(strAddInName, (InStrRev(strAddInName, ".", -1, _
    vbTextCompare) - 1))

    On Error Resume Next
    Set addXL = Excel.AddIns(strAddInName)
    On Error GoTo 0

    If Not addXL Is Nothing Then Exit Sub

    '~~> This is required to avoid the Run-time error '1004':
    '~~> "Unable to get the Add property of the AddIns class"
    '~~> OR
    '~~> "Add method of addins class failed"
    '~~> when there are no workbooks
    Set oTempBk = Workbooks.Add

    Set addXL = AddIns.Add(strFilePath, True)
    addXL.Installed = True

    oTempBk.Close

    ShouldIContinue = True
End Sub