excel - Iterar complementos no registrados(.xla)
vba excel-vba (6)
Necesito ayuda en
- averiguar cómo iterar a través de los archivos de complemento de Excel actualmente abiertos (.xla) que no se han registrado en Excel utilizando la ruta del menú
Tools > Add-ins
. - más específicamente, estoy interesado en cualquier libro que no aparezca en el cuadro de diálogo Complemento, pero tiene
ThisWorkbook.IsAddin = True
.
Demostrando el problema:
Intentar recorrer los libros de trabajo de la siguiente manera no incluye libros de trabajo con .AddIn = True
:
Dim book As Excel.Workbook
For Each book In Application.Workbooks
Debug.Print book.Name
Next book
El bucle a través de complementos no obtiene complementos que no están registrados:
Dim addin As Excel.AddIn
For Each addin In Application.AddIns
Debug.Print addin.Name
Next addin
Looping a través de la colección VBProjects funciona, pero solo si el usuario tiene un acceso específicamente confiable al Proyecto de Visual Basic en la configuración de Seguridad de macros, que rara vez:
Dim vbproj As Object
For Each vbproj In Application.VBE.VBProjects
Debug.Print vbproj.Filename
Next vbproj
Sin embargo, si se conoce el nombre del libro de trabajo, el libro de trabajo se puede referenciar directamente independientemente de si es un complemento o no:
Dim book As Excel.Workbook
Set book = Application.Workbooks("add-in.xla")
¿Pero cómo diablos obtener referencias a este libro de trabajo si el nombre no se conoce y no se puede confiar en la configuración de seguridad de macros del usuario?
¿Es iterativo a través del registro una posibilidad? Sé que eso no te da una instantánea de lo que está usando tu instancia de Excel, sino lo que usaría una nueva instancia, pero dependiendo de para qué lo necesites, podría ser suficiente.
Las claves relevantes son:
''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
Todavía estoy buscando una solución sensata para este problema, pero por el momento parece que leer los textos de las ventanas de todos los libros de trabajo ofrece una colección de todos los libros abiertos, add-in o no:
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
¿Qué tal esto?
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
Cualquier uso?
Use = DOCUMENTS, una función de macro Excel4.
Dim Docs As Variant
Docs = Application.Evaluate("documents(2)")
Aquí está la documentación para ello (disponible aquí ):
DOCUMENTOS
Devuelve, como una matriz horizontal en forma de texto, los nombres de los libros abiertos abiertos en orden alfabético. Use DOCUMENTOS para recuperar los nombres de los libros abiertos para usar en otras funciones que manipulen libros abiertos.
Sintaxis
DOCUMENTOS (type_num, match_text)
Type_num es un número que especifica si se incluyen libros de complemento en la matriz de libros de trabajo, de acuerdo con la siguiente tabla.
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 especifica los libros de trabajo cuyos nombres desea devolver y puede incluir caracteres comodín. Si se omite match_text, DOCUMENTS devuelve los nombres de todos los libros abiertos.
A partir de Office 2010, hay una nueva colección .AddIns2 que es igual que .AddIns pero también incluye los complementos .XLA no registrados.
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
He tenido problemas con los complementos que están instalados (y en el VBE) que no están disponibles a través de Addin
en Exel 2013 (en un entorno de trabajo).
Jugando con la solución de Chris C dio una buena solución.
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