参考になるかどうか分かりませんが、、、、、、、
https://oshiete.goo.ne.jp/qa/5543578.html
「EXCEL VBAで2つEXCELを起動したときのブック名取得の方法」
ここにあった下記ページ
http://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=63055;id=excel
ここのマクロを訳も分からずいじくっていたら他ブックのブック名を取得できました。
なお、コードの意味も分からずたまたまうまくいっただけですので解説も質問への回答もできません。
熟練者さんたちの回答が出るまでの場つなぎのつもりで上げました。
'------------------------------------------------------------------------------------------
Private Declare Function EnumWindows Lib "user32.dll" _
(ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetClassName Lib "user32.dll" _
Alias "GetClassNameA" _
(ByVal hWnd As Long, _
ByVal lpClassName As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function EnumChildWindows Lib "user32.dll" _
(ByVal hWndParent As Long, _
ByVal lpEnumFunc As Long, _
ByVal lParam As Long) As Long
Private Declare Function GetWindowText Lib "user32.dll" _
Alias "GetWindowTextA" _
(ByVal hWnd As Long, _
ByVal lpString As String, _
ByVal nMaxCount As Long) As Long
Private Declare Function SendMessage Lib "user32" _
Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal Msg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Declare Function IIDFromString Lib "ole32" _
(lpsz As Any, lpiid As Any) As Long
Private Declare Function ObjectFromLresult Lib "oleacc" _
(ByVal lResult As Long, riid As Any, _
ByVal wParam As Long, ppvObject As Any) As Long
Private Declare Function IsWindow Lib "user32" _
(ByVal hWnd As Long) As Long
Private Const OBJID_NATIVEOM = &HFFFFFFF0
Private Const OBJID_CLIENT = &HFFFFFFFC
Private Const IID_IMdcList = "{8BD21D23-EC42-11CE-9E0D-00AA006002F3}"
Private Const IID_IUnknown = "{00000000-0000-0000-C000-000000000046}"
Private Const IID_IDispatch = "{00020400-0000-0000-C000-000000000046}"
Private Const WM_GETOBJECT = &H3D&
Type WbkDtl
hWnd As Long
wkb As Excel.Workbook ' 此処にブックのオブジェクトが入る
End Type
Private wD() As WbkDtl
' コールバック関数
Public Function EnumWindowsProc(ByVal hWnd As Long, _
ByVal lParam As Long) As Long
Dim strClassBuff As String * 128
Dim strClass As String
Dim lngRtnCode As Long
Dim lngThreadId As Long
Dim lngProcesID As Long
' クラス名取得
lngRtnCode = GetClassName(hWnd, strClassBuff, Len(strClassBuff))
strClass = Left(strClassBuff, InStr(strClassBuff, vbNullChar) - 1)
If strClass = "XLMAIN" Then
' 子ウィンドウを列挙
lngRtnCode = EnumChildWindows(hWnd, _
AddressOf EnumChildSubProc, lParam)
End If
' 列挙を継続
EnumPass:
EnumWindowsProc = True
End Function
' コールバック関数 - 子ウィンドウを列挙
Private Function EnumChildSubProc(ByVal hwndChild As Long, _
ByVal lParam As Long) As Long
Dim strClassBuff As String * 128
Dim strClass As String
Dim strTextBuff As String * 516
Dim strText As String
Dim lngRtnCode As Long
' クラス名取得
lngRtnCode = GetClassName(hwndChild, strClassBuff, Len(strClassBuff))
strClass = Left(strClassBuff, InStr(strClassBuff, vbNullChar) - 1)
If strClass = "EXCEL7" Then
' テキストをバッファに
lngRtnCode = GetWindowText(hwndChild, strTextBuff, Len(strTextBuff))
strText = Left(strTextBuff, InStr(strTextBuff, vbNullChar) - 1)
If InStr(1, strText, ".xla") = 0 Then '
If Sgn(wD) = 0 Then
ReDim wD(0)
wD(0).hWnd = hwndChild
Else
ReDim Preserve wD(UBound(wD) + 1)
wD(UBound(wD)).hWnd = hwndChild
End If
End If
End If
' 列挙を継続
EnumChildPass:
EnumChildSubProc = True
End Function
Public Sub GetExcelBook(wDl As WbkDtl)
Dim IID(0 To 3) As Long
Dim bytID() As Byte
Dim lngResult As Long
Dim lngRtnCode As Long
Dim wbw As Excel.Window
If IsWindow(wDl.hWnd) = 0 Then Exit Sub
lngResult = SendMessage(wDl.hWnd, WM_GETOBJECT, 0, ByVal OBJID_NATIVEOM)
If lngResult Then
bytID = IID_IDispatch & vbNullChar
IIDFromString bytID(0), IID(0)
lngRtnCode = ObjectFromLresult(lngResult, IID(0), 0, wbw)
If Not wbw Is Nothing Then Set wDl.wkb = wbw.Parent
End If
End Sub
Sub 他ブック名取得()
Dim lngRtnCode As Long
Dim i As Long
Dim last As Long
last = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:A" & last).ClearContents
On Error Resume Next 'これが無いとエラーになった
Erase wD
' ワークブックのウィンドウハンドルを取得
lngRtnCode = EnumWindows(AddressOf EnumWindowsProc, ByVal 0&)
If Sgn(wD) <> 0 Then
For i = 0 To UBound(wD)
Call GetExcelBook(wD(i))
Cells(i, 1) = wD(i).wkb.Name
Next
End If
last = Cells(Rows.Count, 1).End(xlUp).Row
Range("A1:A" & last).Select
ActiveSheet.Range("$A$1:$A$" & last).RemoveDuplicates Columns:=1, Header:=xlNo
For i = 1 To last
If Right(Cells(i, 1).Value, 4) = "XLAM" Then Cells(i, 1).Value = ""
Next
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A1:A" & last)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A1").Select
End Sub
excel マクロ実行中に手動で開いた他のbookを同マクロで認識する方法を教えてください。
