VBA может достигнуть через экземпляры Excel?

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

29
задан I. J. Kennedy 4 June 2010 в 04:15
поделиться

3 ответа

Ответ Корнелиуса частично правильный. Его код получает текущий экземпляр, а затем создает новый экземпляр. 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
31
ответ дан 28 November 2019 в 01:35
поделиться

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

-4
ответ дан 28 November 2019 в 01:35
поделиться

Я считаю, что 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
8
ответ дан 28 November 2019 в 01:35
поделиться
Другие вопросы по тегам:

Похожие вопросы: