迭代未注册的加载项(.xla)

时间:2008-11-13 14:29:21

标签: excel vba excel-vba add-in excel-addins

我需要帮助

  • 弄清楚如何使用Tools > Add-ins菜单路径迭代尚未在Excel中注册的当前打开的Excel加载项文件(。xla)
  • 更具体地说,我对任何未出现在加载项对话框中但具有ThisWorkbook.IsAddin = True的工作簿感兴趣。

证明问题:

尝试按如下方式遍历工作簿不会获得具有.AddIn = True的工作簿:

Dim book As Excel.Workbook

For Each book In Application.Workbooks
    Debug.Print book.Name
Next book

通过加载项循环不会获得未注册的加载项:

Dim addin As Excel.AddIn

For Each addin In Application.AddIns
    Debug.Print addin.Name
Next addin

循环通过VBProjects集合可以正常工作,但前提是用户在宏安全设置中具有对Visual Basic项目的特别可信访问权限 - 这很少:

Dim vbproj As Object

For Each vbproj In Application.VBE.VBProjects
    Debug.Print vbproj.Filename
Next vbproj

但是,如果已知工作簿的名称,则无论是否为加载项,都可以直接引用工作簿:

Dim book As Excel.Workbook
Set book = Application.Workbooks("add-in.xla")

但是,如果名称未知,那么如何获取对此工作簿的引用,并且不能依赖用户的宏安全设置?

6 个答案:

答案 0 :(得分:9)

从Office 2010开始,有一个新的集合.AddIns2与.AddIns相同,但也包含未注册的.XLA插件。

Dim a As AddIn
Dim w As Workbook

On Error Resume Next
With Application
    For Each a In .AddIns2
        If LCase(Right(a.name, 4)) = ".xla" Then
            Set w = Nothing
            Set w = .Workbooks(a.name)
            If w Is Nothing Then
                Set w = .Workbooks.Open(a.FullName)
            End If
        End If
    Next
End With

答案 1 :(得分:1)

我遇到过安装(以及在VBE中)的插件无法通过Exel 2013上的用户Addin(在工作环境中)提供的问题。

从Chris C那里修补the solution给出了一个很好的解决方法。

Dim a As AddIn
Dim wb As Workbook

On Error Resume Next
With Application
    .DisplayAlerts = False
        For Each a In .AddIns2
        Debug.Print a.Name, a.Installed
            If LCase(Right$(a.Name, 4)) = ".xla" Or LCase(Right$(a.Name, 5)) Like ".xla*" Then
                Set wb = Nothing
                Set wb = .Workbooks(a.Name)
                wb.Close False
                Set wb = .Workbooks.Open(a.FullName)
            End If
        Next
   .DisplayAlerts = True
End With

答案 2 :(得分:0)

我仍在寻找这个问题的理智解决方案,但目前看来,阅读所有工作簿窗口的窗口文本会提供所有打开的工作簿的集合,无论是否加载:

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Public Function GetAllOpenWorkbooks() As Collection

'Retrieves a collection of all open workbooks and add-ins.

Const EXCEL_APPLICATION_WINDOW  As String = "XLDESK"
Const EXCEL_WORKBOOK_WINDOW     As String = "EXCEL7"

Dim hWnd                As Long
Dim hWndExcel           As Long
Dim contentLength       As Long
Dim buffer              As String
Dim bookName            As String
Dim books               As Collection

Set books = New Collection

'Find the main Excel window
hWndExcel = FindWindowEx(Application.hWnd, 0&, EXCEL_APPLICATION_WINDOW, vbNullString)

Do

    'Find next window
    hWnd = FindWindowEx(hWndExcel, hWnd, vbNullString, vbNullString)

    If hWnd Then

        'Create a string buffer for 100 chars
        buffer = String$(100, Chr$(0))

        'Get the window class name
        contentLength = GetClassName(hWnd, buffer, 100)

        'If the window found is a workbook window
        If Left$(buffer, contentLength) = EXCEL_WORKBOOK_WINDOW Then

            'Recreate the buffer
            buffer = String$(100, Chr$(0))

            'Get the window text
            contentLength = GetWindowText(hWnd, buffer, 100)

            'If the window text was returned, get the workbook and add it to the collection
            If contentLength Then
                bookName = Left$(buffer, contentLength)
                books.Add Excel.Application.Workbooks(bookName), bookName
            End If

        End If

    End If

Loop While hWnd

'Return the collection
Set GetAllOpenWorkbooks = books

End Function

答案 3 :(得分:0)

这个怎么样:

Public Sub ListAddins()

Dim ai As AddIn

    For Each ai In Application.AddIns
        If Not ai.Installed Then
            Debug.Print ai.Application, ai.Parent, ai.Name, ai.FullName
        End If
    Next

End Sub

有用吗?

答案 4 :(得分:0)

使用= DOCUMENTS,一个Excel4宏函数。

Dim Docs As Variant
Docs = Application.Evaluate("documents(2)")

以下是相关文档(可用here):

<强>文献
作为文本形式的水平数组,以字母顺序返回指定的打开工作簿的名称。使用DOCUMENTS检索要在操作打开的工作簿的其他函数中使用的打开工作簿的名称。

<强>语法
文件(type_num,match_text)
Type_num是一个数字,指定是否在工作簿数组中包含加载项工作簿,如下表所示。

Type_num       Returns
1 or omitted   Names of all open workbooks except add-in workbooks
2              Names of add-in workbooks only
3              Names of all open workbooks

Match_text指定要返回其名称的工作簿,并且可以包含通配符。如果省略match_text,则DOCUMENTS将返回所有打开的工作簿的名称。

答案 5 :(得分:0)

是否有可能通过注册表进行迭代?我知道这并没有给你一个你的Excel实例正在使用的快照,但是新实例会使用什么 - 但是根据你的需要,它可能已经足够了。

相关的密钥是:

'Active add-ins are in values called OPEN*
HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Options

'Inactive add-ins are in values of their full path
HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Add-in Manager