Может ли VBA достичь Экземпляры Excel?

Может ли макрос Excel VBA, работающий в одном экземпляре Excel, обращаться к рабочим книгам другого работающего экземпляра Excel? Например, я хотел бы создать список всех книг, открытых в любом запущенном экземпляре Excel.

Ответ Корнелиуса частично правильный. Его код получает текущий экземпляр, а затем создает новый экземпляр. GetObject только когда-либо получает первый экземпляр, независимо от того, сколько экземпляров доступно. Вопрос, на мой взгляд, заключается в том, как вы можете получить конкретный экземпляр из многих случаев.

Для проекта VBA сделайте два модуля, один модуль кода, а другой в форме с помощью одной командной кнопки Command1. Возможно, вам потребуется добавить ссылку на Microsoft.Excel.

Этот код отображает все имена каждой книги для каждого работающего экземпляра Excel в окне «Немедленное».

 '------------- Code Module -------------- Option Explicit 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 Declare Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As UUID, ByRef ppvObject As Object) As Long Type UUID 'GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type '------------- Form Module -------------- Option Explicit Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}" Const OBJID_NATIVEOM As Long = &HFFFFFFF0 'Sub GetAllWorkbookWindowNames() Sub Command1_Click() On Error GoTo MyErrorHandler Dim hWndMain As Long hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString) Do While hWndMain <> 0 GetWbkWindows hWndMain hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString) Loop Exit Sub MyErrorHandler: MsgBox "GetAllWorkbookWindowNames" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description End Sub Private Sub GetWbkWindows(ByVal hWndMain As Long) On Error GoTo MyErrorHandler Dim hWndDesk As Long hWndDesk = FindWindowEx(hWndMain, 0&, "XLDESK", vbNullString) If hWndDesk <> 0 Then Dim hWnd As Long hWnd = FindWindowEx(hWndDesk, 0, vbNullString, vbNullString) Dim strText As String Dim lngRet As Long Do While hWnd <> 0 strText = String$(100, Chr$(0)) lngRet = GetClassName(hWnd, strText, 100) If Left$(strText, lngRet) = "EXCEL7" Then GetExcelObjectFromHwnd hWnd Exit Sub End If hWnd = FindWindowEx(hWndDesk, hWnd, vbNullString, vbNullString) Loop On Error Resume Next End If Exit Sub MyErrorHandler: MsgBox "GetWbkWindows" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description End Sub Public Function GetExcelObjectFromHwnd(ByVal hWnd As Long) As Boolean On Error GoTo MyErrorHandler Dim fOk As Boolean fOk = False Dim iid As UUID Call IIDFromString(StrPtr(IID_IDispatch), iid) Dim obj As Object If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, iid, obj) = 0 Then 'S_OK Dim objApp As Excel.Application Set objApp = obj.Application Debug.Print objApp.Workbooks(1).Name Dim myWorksheet As Worksheet For Each myWorksheet In objApp.Workbooks(1).Worksheets Debug.Print " " & myWorksheet.Name DoEvents Next fOk = True End If GetExcelObjectFromHwnd = fOk Exit Function MyErrorHandler: MsgBox "GetExcelObjectFromHwnd" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description End Function 

Я считаю, что VBA более силен, чем Чарльз думает;)

Если есть только какой-то сложный способ указать конкретный экземпляр из GetObject и CreateObject, у нас будет проблема!

РЕДАКТИРОВАТЬ:

Если вы создатель всех экземпляров, не должно быть никаких проблем с такими вещами, как перечисление книг. Взгляните на этот код:

 Sub Excels() Dim currentExcel As Excel.Application Dim newExcel As Excel.Application Set currentExcel = GetObject(, "excel.application") Set newExcel = CreateObject("excel.application") newExcel.Visible = True newExcel.Workbooks.Add 'and so on... End Sub 

Я думаю, что в VBA вы можете получить доступ к объекту приложения в другом запущенном экземпляре . Если вы знаете, что имя рабочей книги открыто в другом экземпляре, вы можете получить ссылку на объект приложения. См. Страницу Allen Waytt

Последняя часть,

Dim xlApp As Excel.Application
Set xlApp = GetObject("c:\mypath\ExampleBook.xlsx").Application

Позвонил мне получить указатель на объект приложения экземпляра, в котором был открыт ExampleBook.xlsx .

Я считаю, что «ExampleBook» должен быть полным путем, по крайней мере, в Excel 2010. В настоящее время я экспериментирую с этим сам, поэтому я попробую и обновить, когда получаю более подробную информацию.

Предположительно, могут быть сложности, если отдельные экземпляры открываются одной и той же книгой, но только один может иметь доступ на запись.

Благодаря этой замечательной почте у меня была рутина, чтобы найти массив всех приложений Excel, которые в настоящее время работают на машине. Проблема в том, что я только что обновился до 64-битного Office Office, и все пошло не так.

Существует обычная проблема преобразования ... Declare Function ... в ... Declare PtrSafe Function ... , которая хорошо документирована в другом месте. Однако то, что я не мог найти в документации, это тот факт, что иерархия окон (XLMAIN ‘->’ XLDESK ‘->’ EXCEL7 ‘), которую ожидает исходный код, изменилась после этого обновления. Для тех, кто идет по моим стопам, чтобы спасти вас после полудня, я решил опубликовать обновленный сценарий. Трудно проверить, но я думаю, что он должен быть обратно совместим и для хорошей оценки.

 Option Explicit #If Win64 Then Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal Hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As LongPtr) As LongPtr Private Declare PtrSafe Function IIDFromString Lib "ole32" (ByVal lpsz As LongPtr, ByRef lpiid As UUID) As LongPtr Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" (ByVal Hwnd As LongPtr, ByVal dwId As LongPtr, ByRef riid As UUID, ByRef ppvObject As Object) As LongPtr #Else 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 IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long Private Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hwnd As Long, ByVal dwId As Long, ByRef riid As UUID, ByRef ppvObject As Object) As Long #End If Type UUID 'GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}" Const OBJID_NATIVEOM As LongPtr = &HFFFFFFF0 ' Run as entry point of example Public Sub Test() Dim i As Long Dim xlApps() As Application If GetAllExcelInstances(xlApps) Then For i = LBound(xlApps) To UBound(xlApps) If xlApps(i).Workbooks(1).Name <> ThisWorkbook.Name Then MsgBox (xlApps(i).Workbooks(1).Name) End If Next End If End Sub ' Actual public facing function to be called in other code Public Function GetAllExcelInstances(xlApps() As Application) As Long On Error GoTo MyErrorHandler Dim n As Long #If Win64 Then Dim hWndMain As LongPtr #Else Dim hWndMain As Long #End If Dim app As Application ' Cater for 100 potential Excel instances, clearly could be better ReDim xlApps(1 To 100) hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString) Do While hWndMain <> 0 Set app = GetExcelObjectFromHwnd(hWndMain) If Not (app Is Nothing) Then If n = 0 Then n = n + 1 Set xlApps(n) = app ElseIf checkHwnds(xlApps, app.Hwnd) Then n = n + 1 Set xlApps(n) = app End If End If hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString) Loop If n Then ReDim Preserve xlApps(1 To n) GetAllExcelInstances = n Else Erase xlApps End If Exit Function MyErrorHandler: MsgBox "GetAllExcelInstances" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description End Function #If Win64 Then Private Function checkHwnds(xlApps() As Application, Hwnd As LongPtr) As Boolean #Else Private Function checkHwnds(xlApps() As Application, Hwnd As Long) As Boolean #End If Dim i As Integer For i = LBound(xlApps) To UBound(xlApps) If xlApps(i).Hwnd = Hwnd Then checkHwnds = False Exit Function End If Next i checkHwnds = True End Function #If Win64 Then Private Function GetExcelObjectFromHwnd(ByVal hWndMain As LongPtr) As Application #Else Private Function GetExcelObjectFromHwnd(ByVal hWndMain As Long) As Application #End If On Error GoTo MyErrorHandler #If Win64 Then Dim hWndDesk As LongPtr Dim Hwnd As LongPtr #Else Dim hWndDesk As Long Dim Hwnd As Long #End If Dim strText As String Dim lngRet As Long Dim iid As UUID Dim obj As Object hWndDesk = FindWindowEx(hWndMain, 0&, "XLDESK", vbNullString) If hWndDesk <> 0 Then Hwnd = FindWindowEx(hWndDesk, 0, vbNullString, vbNullString) Do While Hwnd <> 0 strText = String$(100, Chr$(0)) lngRet = CLng(GetClassName(Hwnd, strText, 100)) If Left$(strText, lngRet) = "EXCEL7" Then Call IIDFromString(StrPtr(IID_IDispatch), iid) If AccessibleObjectFromWindow(Hwnd, OBJID_NATIVEOM, iid, obj) = 0 Then 'S_OK Set GetExcelObjectFromHwnd = obj.Application Exit Function End If End If Hwnd = FindWindowEx(hWndDesk, Hwnd, vbNullString, vbNullString) Loop On Error Resume Next End If Exit Function MyErrorHandler: MsgBox "GetExcelObjectFromHwnd" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description End Function 

У меня была аналогичная проблема / цель.

И я получил ответ ForEachLoops на работу, но есть необходимые изменения. В нижней функции (GetExcelObjectFromHwnd) он использовал индекс рабочей книги 1 в обеих командах debug.print. В результате вы видите только первый WB.

Поэтому я взял его код и поместил цикл for в GetExcelObjectFromHwnd и изменил значение 1 на счетчик. в результате я могу получить ВСЕ активные книги excel и вернуть информацию, необходимую мне, чтобы охватить экземпляры Excel и получить доступ к другим WB.

И я создал Тип, чтобы упростить извлечение информации и передать ее обратно вызывающей подпрограмме:

 Type TargetWBType name As String returnObj As Object returnApp As Excel.Application returnWBIndex As Integer End Type 

Для имени я просто использовал базовое имя файла, например «example.xls». Этот fragment доказывает функциональность, выплевывая значение A6 на каждом WS целевого WB. Вот так:

 Dim targetWB As TargetWBType targetWB.name = "example.xls" Call GetAllWorkbookWindowNames(targetWB) If Not targetWB.returnObj Is Nothing Then Set targetWB.returnApp = targetWB.returnObj.Application Dim ws As Worksheet For Each ws In targetWB.returnApp.Workbooks(targetWB.returnWBIndex).Worksheets MsgBox ws.Range("A6").Value Next Else MsgBox "Target WB Not found" End If 

Итак, теперь модуль ENTIRE, изначально созданный ForEachLoop, выглядит так, и я указал изменения, которые я сделал. У него есть всплывающее окно msgbox, которое я оставил в fragmentе для целей отладки. Разделите это, когда он найдет вашу цель. Код:

 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 Declare Function GetClassName Lib "User32" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Declare Function IIDFromString Lib "ole32" (ByVal lpsz As Long, ByRef lpiid As UUID) As Long Declare Function AccessibleObjectFromWindow Lib "oleacc" (ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As UUID, ByRef ppvObject As Object) As Long Type UUID 'GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(7) As Byte End Type '------------- Form Module -------------- Option Explicit Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}" Const OBJID_NATIVEOM As Long = &HFFFFFFF0 'My code: added targetWB Sub GetAllWorkbookWindowNames(targetWB As TargetWBType) On Error GoTo MyErrorHandler Dim hWndMain As Long hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString) Do While hWndMain <> 0 GetWbkWindows hWndMain, targetWB 'My code: added targetWB hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString) Loop Exit Sub MyErrorHandler: MsgBox "GetAllWorkbookWindowNames" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description End Sub 'My code: added targetWB Private Sub GetWbkWindows(ByVal hWndMain As Long, targetWB As TargetWBType) On Error GoTo MyErrorHandler Dim hWndDesk As Long hWndDesk = FindWindowEx(hWndMain, 0&, "XLDESK", vbNullString) If hWndDesk <> 0 Then Dim hWnd As Long hWnd = FindWindowEx(hWndDesk, 0, vbNullString, vbNullString) Dim strText As String Dim lngRet As Long Do While hWnd <> 0 strText = String$(100, Chr$(0)) lngRet = GetClassName(hWnd, strText, 100) If Left$(strText, lngRet) = "EXCEL7" Then GetExcelObjectFromHwnd hWnd, targetWB 'My code: added targetWB Exit Sub End If hWnd = FindWindowEx(hWndDesk, hWnd, vbNullString, vbNullString) Loop On Error Resume Next End If Exit Sub MyErrorHandler: MsgBox "GetWbkWindows" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description End Sub 'My code: added targetWB Public Function GetExcelObjectFromHwnd(ByVal hWnd As Long, targetWB As TargetWBType) As Boolean On Error GoTo MyErrorHandler Dim fOk As Boolean fOk = False Dim iid As UUID Call IIDFromString(StrPtr(IID_IDispatch), iid) Dim obj As Object If AccessibleObjectFromWindow(hWnd, OBJID_NATIVEOM, iid, obj) = 0 Then 'S_OK Dim objApp As Excel.Application Set objApp = obj.Application 'My code Dim wbCount As Integer For wbCount = 1 To objApp.Workbooks.Count 'End my code 'Not my code Debug.Print objApp.Workbooks(wbCount).name 'My code If LCase(objApp.Workbooks(wbCount).name) = LCase(targetWB.name) Then MsgBox ("Found target: " & targetWB.name) Set targetWB.returnObj = obj targetWB.returnWBIndex = wbCount End If 'End My code 'Not my code Dim myWorksheet As Worksheet For Each myWorksheet In objApp.Workbooks(wbCount).Worksheets Debug.Print " " & myWorksheet.name DoEvents Next 'My code Next 'Not my code fOk = True End If GetExcelObjectFromHwnd = fOk Exit Function MyErrorHandler: MsgBox "GetExcelObjectFromHwnd" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description End Function 

Повторяю, это работает, и используя переменные в типе TargetWB, я надежно просматриваю книги и рабочие листы в экземплярах Excel.

Единственная потенциальная проблема, которую я вижу с моим решением, – это если у вас несколько WB с тем же именем. Прямо сейчас, я верю, что он вернет последний экземпляр этого имени. Если мы добавим Exit For в If Then, я верю, что вместо этого вернет первый экземпляр. Я не тестировал эту часть, поскольку в моем приложении есть только один экземпляр файла.

Чтобы добавить к ответу Джеймса Макади, я думаю, что вы делаете повтор слишком поздно, потому что в функции checkHwnds вы получаете ошибку вне диапазона, поскольку вы пытаетесь проверить значения до 100, даже если вы еще не заполнили массив полностью? Я изменил код ниже, и теперь он работает для меня.

 ' Actual public facing function to be called in other code Public Function GetAllExcelInstances(xlApps() As Application) As Long On Error GoTo MyErrorHandler Dim n As Long #If Win64 Then Dim hWndMain As LongPtr #Else Dim hWndMain As Long #End If Dim app As Application ' Cater for 100 potential Excel instances, clearly could be better ReDim xlApps(1 To 100) hWndMain = FindWindowEx(0&, 0&, "XLMAIN", vbNullString) Do While hWndMain <> 0 Set app = GetExcelObjectFromHwnd(hWndMain) If Not (app Is Nothing) Then If n = 0 Then n = n + 1 ReDim Preserve xlApps(1 To n) Set xlApps(n) = app ElseIf checkHwnds(xlApps, app.Hwnd) Then n = n + 1 ReDim Preserve xlApps(1 To n) Set xlApps(n) = app End If End If hWndMain = FindWindowEx(0&, hWndMain, "XLMAIN", vbNullString) Loop If n Then GetAllExcelInstances = n Else Erase xlApps End If Exit Function MyErrorHandler: MsgBox "GetAllExcelInstances" & vbCrLf & vbCrLf & "Err = " & Err.Number & vbCrLf & "Description: " & Err.Description End Function 

Я не считаю, что это возможно, используя только VBA, потому что объектом самого высокого уровня, к которому вы можете добраться, является объект Application, который является текущим экземпляром Excel.

  • Создание и присвоение имен в Excel VBA
  • Вставка диапазона Excel в электронное письмо как изображение
  • VBA: использование WithEvents в UserForms
  • Где находится VBA Debug.Print?
  • VBA извлекает данные XML в Excel
  • Быстрый способ получить все уникальные значения столбца в VBA?
  • В Excel, сделав «Стоп-кавычки» в правом столбце вместо самого левого?
  • Копирование из одной книги и вставка в другую
  • Есть ли более быстрый CountIF
  • Ошибка: «Не удалось найти Installable ISAM»
  • Как открыть файл Excel VBA с использованием приложения по умолчанию
  • Interesting Posts

    Аннотирование функционального интерфейса выражения Lambda

    Скрыть пользователя от экрана входа в систему без его деактивации

    Есть ли способ принудительного ввода текста в NSArray, NSMutableArray и т. Д.?

    Почему InetAddress.isReachable возвращает false, когда я могу выполнить ping IP-адрес?

    Как добавить время отладки к асинхронному валидатору в угловом 2?

    Как firstprivate и lastprivate отличаются от private clauses в OpenMP?

    Определение даты создания файла в Java

    Как сделать второе преобразование на выходе XSLT-шаблона

    Перенаправить вывод консоли в текстовое поле в отдельной программе

    Создание UUID в инструкции Postgres for Insert?

    Как показать круговой текст с помощью TextView в Android

    RabbitMQ 3.3.1 не может войти с гостевой / гостевой

    Масштабирование изображения с помощью CSS: есть ли альтернатива webkit для -moz-crisp-edge?

    Маршрутизация интернета через ethernet на компьютер без беспроводного адаптера

    Измените команду-вкладку на вкладку опций на Mac

    Давайте будем гением компьютера.