| |
▼neptune さん：
サンプルコードまで書いて頂いて、ありがとうございます。
最初の書かれていました
>「つかむ」をHWNDを取得することで満足できるなら、
>FindWindow APIではだめなんでしょうか？
この意味がわかっていなかったようです・・・
例では子Windowを移動させていますが、(余計な手間をかけてすいません）
実際は子WindowのinnerText（もしくはソース）を引っ張って
データ取得しようしていました。
hwndからオブジェクトを取得するには、またまたAPIでやる必要がありそうですね。
提示して頂いたサンプルコードを調べていたのですが、
「AddressOf」演算子あたりで脳ミソから煙が出ました。
アドレスのポインタって・・C言語っぽい・・・
neptuneさんのコードはとりあえずBlackBoxとして・・・
下記のコードで子Windowを移動させることができました。
理解できないコードを使うのは怖いので、もうちょっとレベル上げに励みます。
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function EnumWindows Lib "user32" _
(ByVal lpEnumFunc As Long, ByVal lparam As Long) 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 MoveWindow Lib "user32" _
(ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, _
ByVal nWidth As Long, ByVal nHeight As Long, _
ByVal bRepaint As Long) As Long
Private Const IEClassName As String = "IEFrame" 'IEのClass名
Private Const XLClassName As String = "XLMAIN" 'XL2000
Private Const MAX_PATH As Long = 255
Private FirstIE As Long '１個目のIEのHWND保存用
Private OtherIE As Long '戻り値用変数
Function FindIE(phWnd As Long) As Long
Dim handle As Long
Dim ret As Boolean
Dim sTitle As String
handle = FindWindow(XLClassName, Application.Caption)
OtherIE = -1 '戻り値用変数の初期化
ret = EnumWindows(AddressOf EnumFunc, phWnd)
'取得できたら
If ret = False And OtherIE > 0 Then
FindIE = OtherIE
End If
End Function
Private Function EnumFunc(ByVal hwnd As Long, _
ByVal lparam As Long) As Boolean
Dim sClassName As String * MAX_PATH
Dim sbuf As String
EnumFunc = True
GetClassName hwnd, sClassName, MAX_PATH
sbuf = Left(sClassName, InStr(1, sClassName, Chr(0)) - 1)
If sbuf = IEClassName Then
If hwnd <> lparam Then
OtherIE = hwnd
EnumFunc = False
End If
End If
End Function
'−−−−ここまでが頂いたサンプル(Test_Sub以外）
Sub Main()
Dim objIE As Object
Dim StrURL As String
Dim Cnt As Long
Dim Target As Long '取得したい子Windowのhwnd
Dim Old_Win() As Long '取得済みのhwndを管理する配列
Cnt = 0
ReDim Old_Win(Cnt)
Old_Win(Cnt) = 0
'すでに IEを開いてないかチェック
FirstIE = FindWindow(IEClassName, vbNullString)
If FirstIE <> 0 Then
MsgBox "IEがすでに開いています。全て閉じてください"
Exit Sub
End If
''禁止語句に引っかかるのでこちらのTopページのアドレスを入れてください
StrURL = "XXXX://www.vbalab.net/"
Set objIE = CreateObject("InternetExplorer.application")
With objIE
.Navigate StrURL
.Visible = True
'読み込み終了を待つ
Do While .Busy = True
DoEvents
Loop
'念のため、もう１回 DoEvents
DoEvents
End With
'ここで最初のWindowを取得
FirstIE = FindWindow(IEClassName, vbNullString)
Debug.Print "１個目： " & FirstIE
'子Window1枚目を開く
objIE.Document.Forms(0).Submit
'5秒待つ
Application.Wait Now + TimeSerial(0, 0, 5)
DoEvents
Target = GetNewIE(FirstIE, Old_Win)
Debug.Print "２個目： " & Target
'左上に移動
MoveWindow Target, 1, 1, 300, 300, True
'TargetをOld_Winに追加
Cnt = Cnt + 1
ReDim Preserve Old_Win(Cnt)
Old_Win(Cnt) = Target
'子Window2枚目を開く
objIE.Document.links(0).Click
'5秒待つ
Application.Wait Now + TimeSerial(0, 0, 5)
DoEvents
Target = GetNewIE(FirstIE, Old_Win)
Debug.Print "３個目： " & Target
'移動
MoveWindow Target, 300, 1, 300, 300, True
'TargetをOld_Winに追加
Cnt = Cnt + 1
ReDim Preserve Old_Win(Cnt)
Old_Win(Cnt) = Target
MsgBox "終了"
Set objIE = Nothing
Erase Old_Win
End Sub
Function GetNewIE(ByVal ParentIE As Long, Old_Ary As Variant) As Long
Dim v As Variant
Dim Lmt As Integer '無限ループの防止用リミッタ
Do
v = FindIE(ParentIE)
If Lmt > 30 Then
GetNewIE = 0: Exit Function
Else
Lmt = Lmt + 1
End If
Loop Until IsError(Application.Match(v, Old_Ary, 0))
GetNewIE = CLng(v)
End Function
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
