VBA가 Excel 인스턴스 간에 연결할 수 있습니까?

VBA가 Excel 인스턴스 간에 연결할 수 있습니까?

Excel의 한 인스턴스에서 실행되는 Excel VBA 매크로가 다른 실행 중인 Excel의 워크북에 액세스할 수 있습니까?예를 들어, 실행 중인 Excel 인스턴스에서 열려 있는 모든 문제집 목록을 만들고 싶습니다.

코넬리우스의 대답은 부분적으로 맞습니다.그의 코드는 현재 인스턴스를 가져온 다음 새 인스턴스를 만듭니다.GetObject는 사용 가능한 인스턴스 수에 관계없이 첫 번째 인스턴스만 가져옵니다.제가 생각하는 문제는 어떻게 하면 많은 사례 중에서 특정 사례를 얻을 수 있을까 하는 것입니다.

VBA 프로젝트의 경우 Command1이라는 하나의 명령 버튼으로 두 개의 모듈, 하나의 코드 모듈, 다른 하나의 모듈을 양식으로 만듭니다.Microsoft에 대한 참조를 추가해야 할 수 있습니다.훌륭합니다.

이 코드는 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열다.

적어도 Excel 2010에서는 "ExampleBook"이 전체 경로가 되어야 한다고 생각합니다.현재 제가 직접 실험 중이니 자세한 내용이 나오면 업데이트해보겠습니다.

개별 인스턴스에 동일한 워크북이 열려 있는 경우 문제가 발생할 수 있지만 한 인스턴스에만 쓰기 권한이 있을 수 있습니다.

이 훌륭한 게시물 덕분에 현재 기계에서 실행 중인 모든 Excel 응용프로그램의 배열을 찾는 루틴이 있었습니다.문제는 방금 Office 2013 64비트로 업그레이드했는데 모든 것이 잘못되었다는 것입니다.

변환하는 일반적인 방법이 있습니다.... 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

저도 비슷한 문제/목표가 있었습니다.

그리고 For Each Loops의 답변을 받았습니다. 하지만 변경해야 할 사항이 있습니다.맨 아래 함수(GetExcelObjectFromHwnd)에서 두 debug.print 명령 모두에서 워크북 인덱스 1을 사용했습니다.그 결과 첫 번째 WB만 표시됩니다.

그래서 저는 그의 코드를 가져와서 GetExcelObjectFromHund에 for 루프를 넣고 1을 카운터로 변경했습니다.그 결과 활성 Excel 워크북을 모두 가져올 수 있고 Excel 인스턴스 전체에서 액세스하고 다른 WB에 액세스하는 데 필요한 정보를 반환할 수 있습니다.

그리고 정보 검색을 단순화하고 호출하는 서브루틴에 다시 전달하기 위해 Type을 만들었습니다.

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

이름에 대해서는 단순히 기본 파일 이름(예: "example.xls")을 사용했습니다.이 스니펫은 대상 WB의 모든 WS에서 A6의 값을 뱉어냄으로써 기능성을 입증합니다.이와 같은 경우:

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

이제 ForEachLoop이 처음에 만든 전체 모듈은 다음과 같습니다. 제가 변경한 내용을 표시했습니다.디버깅을 위해 스니펫에 남긴 메시지 상자 팝업이 있습니다.목표물을 찾으면 제거합니다.코드:

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

반복합니다. 이것은 작동하고 대상 내 변수를 사용합니다.WB 유형 Excel 인스턴스 전체에서 워크북과 워크시트에 안정적으로 액세스합니다.

이 솔루션의 유일한 잠재적 문제는 이름이 같은 WB가 여러 개 있다는 것입니다.현재로서는 해당 이름의 마지막 인스턴스가 반환될 것으로 생각됩니다.만약 우리가 Exit For를 If Then에 추가한다면, 나는 그것이 대신 그것의 첫 번째 인스턴스를 반환할 것이라고 믿습니다.제 애플리케이션에는 파일이 한 번만 열려 있기 때문에 이 부분을 충분히 테스트하지 않았습니다.

James MacAdie의 답변을 덧붙이자면, 당신은 redim을 너무 늦게 하는 것 같습니다. 왜냐하면 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

당신이 얻을 수 있는 가장 높은 수준의 객체는 현재 Excel의 인스턴스인 Application 객체이기 때문에 VBA만을 사용하여 이것이 가능하다고 생각하지 않습니다.

언급URL : https://stackoverflow.com/questions/2971473/can-vba-reach-across-instances-of-excel