Итерация незарегистрированных надстроек (.xla) - PullRequest
9 голосов
/ 13 ноября 2008

Мне нужна помощь в

  • выяснение, как перебирать открытые в настоящее время файлы надстроек Excel (. Xla) , которые не были зарегистрированы в Excel с использованием пути меню Tools > Add-ins.
  • более конкретно, меня интересует любая книга, которая не отображается в диалоговом окне надстройки, но имеет 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 в настройках Macro Security - что редко бывает:

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 ]

9 голосов
/ 18 января 2013

Начиная с 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 голос
/ 21 сентября 2016

У меня были проблемы с надстройками, которые установлены (и в VBE) и недоступны через пользователя Addin в Exel 2013 (в рабочей среде).

Исправление с решением от Криса С. дало хороший обходной путь.

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
0 голосов
/ 12 декабря 2008

Возможно ли перебирать реестр? Я знаю, что это не дает вам снимок того, что использует ваш экземпляр 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
0 голосов
/ 28 ноября 2008

Использование = ДОКУМЕНТЫ, функция макроса Excel4.

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

Вот документация для него (доступно здесь ):

ДОКУМЕНТЫ
Возвращает в виде горизонтального массива в текстовом виде имена указанных открытых рабочих книг в алфавитном порядке. Используйте 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 возвращает имена всех открытых рабочих книг.

0 голосов
/ 26 ноября 2008

Что по этому поводу:

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

Любое использование?

0 голосов
/ 13 ноября 2008

Я все еще в поисках разумного решения этой проблемы, но в настоящее время кажется, что чтение текстов окон всех окон рабочих книг дает коллекцию всех открытых рабочих книг, надстройки или нет:

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
...