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
'source' 카테고리의 다른 글
오류: Definition= 'MachineToApplication'이(가) 응용 프로그램 수준을 초과하도록 허용합니다. (0) | 2023.05.17 |
---|---|
jQuery.ajax()에서 "async: false"는 무엇을 합니까? (0) | 2023.05.17 |
C#은 두 개체 유형을 서로 비교하지 못하지만 VB는 비교하지 못하는 이유는 무엇입니까? (0) | 2023.05.17 |
은색 빛에서 자식 요소의 너비를 부모 요소의 너비에 바인딩하는 방법 (0) | 2023.05.17 |
Angular 2: 'input'의 알려진 속성이 아니므로 'ngModel'에 바인딩할 수 없습니다. (0) | 2023.05.17 |