- ベストアンサー
EnumChildWindowsの使い方(VBA)
- 64bit版ExcelのVBAでEnumChildWindowsを使用して、子ウィンドウのウィンドウハンドルを取得する方法について教えてください。
- サンプルコードを作成しましたが、コールバック関数でExcelが異常終了してしまいます。また、コールバック関数の引数の型を変えても同様の結果となります。
- なお、32bit版のExcelでは正常に動作しました。64bit版ExcelでのEnumChildWindowsの使い方を教えてください。
- mmvba002
- お礼率100% (1/1)
- Visual Basic
- 回答数1
- ありがとう数2
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
関連するQ&A
- VBAでSetTextColorがうまくいかない
EXCELのVBAでユーザーフォームを使ったグラフィック表示のプログラムを 作っているのですが、SetTextColorでテキスト色の設定をしようと してもうまくいきません。何故か設定しようとする色の値が無視されて 「1304008」が設定されてしまいます。(GetTextColorで確認) そしてそれ以降何を設定してもこの状態のままです。 何か考えられることがありますでしょうか。 下にそのプログラムを示します。 ちなみにSetBKColorやAngleArcなど他のグラフィック命令は問題なく 動いていてSetTextColorだけがうまくいってない状態です。 '------------------------------------------------- ' ユーザーフォーム用プログラム '------------------------------------------------- Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpszClass As String, _ ByVal lpszWindow As String) As Long Private Declare Function GetDC Lib "user32" ( _ ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hdc As Long) As Long Private Declare Function SetTextColor Lib "gdi32" _ (ByVal hdc As Long, crColor As Long) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _ (ByVal hdc&, ByVal x&, _ ByVal y&, ByVal lpString$, ByVal nCount&) As Long Dim hWnd As Long Dim hdc As Long Public Sub UserForm_Activate() DoEvents hWnd = FindWindowEx(GetActiveWindow, 0, "F3 Server 60000000", "") hdc = GetDC(hWnd) ret = SetTextColor(hdc, RGB(255, 0, 0)) ret = TextOut(hdc, 0, 0, "abc", 3) Call ReleaseDC(hWnd, hdc) End Sub '-------------------------------------------------
- ベストアンサー
- Visual Basic
- VBA ウィンドウの列挙 Win32 API
http://d.hatena.ne.jp/cartooh/20090618 上記のページに記載されているVBAです。 動作は確認できたのですが、どのような処理の流れとなっているのかがわかりません。 どなたかコメントを付けていただけないでしょうか。 よろしくお願いいたします。 Option Explicit Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal cnm As String, ByVal cap As String) As Long Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, _ ByVal cch As Long) 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 EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, _ ByVal lParam As Long) As Long Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long Const INDENT_KEY = "INDENT" Public Function EnumChildWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long EnumChildWindowsProc = EnumWindowsProc(hWnd, lParam) End Function Public Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Object) As Long EnumWindowsProc = True If IsWindowVisible(hWnd) = 0 Then Exit Function End If Dim strClassName As String ' * 255 Dim strCaption As String ' * 255 strClassName = String(255, vbNullChar) strCaption = String(255, vbNullChar) GetWindowText hWnd, strCaption, Len(strCaption) GetClassName hWnd, strClassName, Len(strClassName) strCaption = RTrim(left(strCaption, InStr(1, strCaption, vbNullChar) - 1)) strClassName = RTrim(left(strClassName, InStr(1, strClassName, vbNullChar) - 1)) ActiveCell.Cells(1, 1).Value = Hex(hWnd) ActiveCell.Cells(1, 2).Value = IsWindowVisible(hWnd) ActiveCell.Cells(1, 3).Value = strCaption ActiveCell.Cells(1, 4).Value = strClassName ActiveCell.Cells(2, 2).Activate Dim c As Collection Set c = lParam Dim indent As Long indent = c(INDENT_KEY) c.Add String(indent * 2, " ") & Hex(hWnd) & " " & strCaption & " " & strClassName, before:=c.Count indent = indent + 1 c.Remove INDENT_KEY c.Add indent, INDENT_KEY Call EnumChildWindows(hWnd, AddressOf EnumChildWindowsProc, ObjPtr(c)) indent = c(INDENT_KEY) - 1 c.Remove INDENT_KEY c.Add indent, INDENT_KEY ActiveCell.Cells(1, 0).Activate End Function Sub hoge() Application.ScreenUpdating = False Dim sht As Worksheet Set sht = ThisWorkbook.Worksheets(1) sht.UsedRange.Clear sht.Activate sht.Range("A1").Activate Dim c As Collection Set c = New Collection c.Add 0, INDENT_KEY Dim ret As Long ret = EnumWindows(AddressOf EnumWindowsProc, ObjPtr(c)) c.Remove INDENT_KEY Set sht = ThisWorkbook.Worksheets(2) sht.UsedRange.Clear sht.Activate sht.Range("A1").Activate Dim o As Variant For Each o In c ActiveCell.Value = o ActiveCell.Cells(2, 1).Activate Next Application.ScreenUpdating = True End Sub
- 締切済み
- Visual Basic
- windows7のエクスプローラをVBAで操作－１
アドバイスをお願いします。 Excel－VBAで起動しているエクスプローラに対してハンドルを取得してクリックしたり、テキストボックスに文字をセットするプログラムを作って動かしています。 WindowsXPのときはできていたのですが、Windows7になったら正しく動作しなくなりました。 下のコードはエクスプローラの現在のフォルダパスが表示されるところに（添付ファイル参照）文字を入れるものです。 最後のSendMessageAnyで１が返ってしまいます。何が考えられますでしょうか。どう対策したらいいでしょうか。 なおハンドルの値はSDKのInspect Objectsで確認していますので、正しく取得できていると思っています。 よろしくお願いします。 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Declare Function SendMessageAny Lib "user32.dll" _ Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal MSG As Long, _ ByVal wParam As Long, _ ByVal lParam As Any) As Long Const WM_SETTEXT = &HC Private hwnd As Long Private FOLDER As String Sub Put_folder_name1() hwnd = FindWindow("CabinetWClass", vbNullString) hwnd = FindWindowEx(hwnd, 0, "WorkerW", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ReBarWindow32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Address Band Root", vbNullString) hwnd = FindWindowEx(hwnd, 0, "msctls_progress32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ComboBoxEx32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ComboBox", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Edit", vbNullString) FOLDER = "\\xx.xx.xx.xx\test" RC = SendMessageAny(hwnd, WM_SETTEXT, 0, ByVal FOLDER) end sub
- ベストアンサー
- Windows 7
- windows7のエクスプローラをVBAで操作－２
アドバイスをお願いします。 Excel－VBAで起動しているエクスプローラに対してハンドルを取得してクリックしたり、テキストボックスに文字をセットするプログラムを作って動かしています。 WindowsXPのときはできていたのですが、Windows7になったら正しく動作しなくなりました。 下のコードはエクスプローラのフォルダパスの右のボタン（添付ファイル参照）をクリックすべく、コーディングしたものです。 最後のSendMessage(hwnd, BM_CLICK, 0, 0) でクリックしたいのですが、その前にボタンのハンドルが取得できません。SDKのInspect Objectsで調べると、このボタンはClass="ToolbarWindow32"でName="前の場所"ですが、NativeWindowHandleが表示されず、Legacy.IAccessible.ChildID=1となっています。 このようなウィンドゥは別のやり方（IAccessible？）でないとクリックできないように感じていますが如何せん知識がありません。 どうしたらできるか、アドバイスよろしくお願いします。 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, lParam As Any) As Long Const BM_CLICK = &HF5 Private hwnd As Long Sub Click_button() hwnd = FindWindow("CabinetWClass", vbNullString) hwnd = FindWindowEx(hwnd, 0, "WorkerW", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ReBarWindow32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Address Band Root", vbNullString) hwnd = FindWindowEx(hwnd, 0, "msctls_progress32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ToolbarWindow32", vbNullString) ' この次が分からない。 RC = SendMessage(hwnd, BM_CLICK, 0, 0) end sub
- ベストアンサー
- Windows 7
- ExcelVBA Delegate文がエラーになる
Excel2010 VBAでの質問です。 画面上のすべてのトップレベルウィンドウを取り出そうと、標準モジュールに以下コーディングしました。 Option Explicit Declare Function EnumWindows Lib "User32.dll" (ByVal Proc As EnumWinProc, ByVal lParam As Integer) As Boolean Delegate EnumWinProc (ByVal hwnd As IntPtr, ByVal lParam As Integer) As Boolean Sub Main() Call EnumWindows(AddressOf disp_hwnd, 0) MsgBox ("完了") End Sub Function disp_hwnd(ByVal hwnd As IntPtr, ByVal lParam As Integer) As Boolean MsgBox (hwnd) disp_hwnd = True End Function そうしたところ、Delegate 文が赤文字に反転してエラーになります。 Excel2003 VBAでは使えない構文なのでしょうか？あるいは何かのミスなのでしょうか？ 環境ですが、WindowsXP SP3、Excel2003 SP3です。 .NET Framework1.1、2.0、3.0、4.0がインストールされています。 あと、以下の参照設定はあります。 Visual Basic For Applications Microsoft Excel 11.0 Object Library OLE Automation Microsoft Office 11.0 Object Library Microsoft Forms 2.0 Object Library Microsoft Scripting Runtime Microsoft Windows Common Controls 6.0 (SP6) 以上、よろしくお願いします。
- ベストアンサー
- Visual Basic
- Formを動かせるようにしたい
お世話になります。 OS XP PRO VB6（SP５）で開発しています。 ディスプレイのサイズによりFormを動かせたり固定させたりしたいのですが、 規定値は固定にしたいのでFormプロパティのMoveableはFalseにしてあります。 下記のようにプログラミングしたのですが固定されたままです。 Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function GetSystemMenu Lib "user32" (ByVal _ hwnd As Long _ , ByVal bRevert As Long) As Long Private Declare Function RemoveMenu Lib "user32" ( _ ByVal hMenu As Long, ByVal nPosition As Long, _ ByVal wFlags As Long) As Long Private Declare Function DrawMenuBar Lib "user32" ( _ ByVal hwnd As Long) As Long Private Const MF_BYCOMMAND = &H0 Private Const SC_MOVE = &HF010 Private Sub Form_Load() Dim kk As Long kk = GetSystemMenu(.hwnd, bb) Call RemoveMenu(kk, SC_MOVE, MF_BYCOMMAND) Call DrawMenuBar(.hwnd) End Sub アドバイス頂きたくよろしくお願いします。 以上です。
- ベストアンサー
- Visual Basic
- VBAでIEの「ファイルのダウンロード」ダイアログを制御
VBではなくVBAにて、IEの「ファイルのダウンロード」ダイアログを制御したいと思い、過去の同様の質問等を参考に下記のソースを作成して動かしてみましたが、「ファイルのダウンロード」画面で、「保存(S)」ボタンのハンドルを取得するところまではできましたが、sendMessageでクリックができず、次に進むことが出来ませんでした。 手動で「保存(S)」ボタンを押下して、強制的に「名前を付けて保存」画面に遷移させた後プログラムを再開すると、同画面の「保存(S)」ボタンのクリックはできました。 同じロジックで「名前を付けて保存」画面の「保存(S)」は動くのに、「ファイルのダウンロード」画面の「保存(S)」が動かないのはなぜでしょうか。 どなたかおわかりになる方がいらっしゃいましたら、ご回答をお願いします。 ***使用環境*** OS: XP pro IE: 6 OFFICE:2002 ***以下作成したソース（エラー制御は省略）*** Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long 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 SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetDlgCtrlID Lib "user32" (ByVal hwnd As Long) As Long Private Sub Test() Dim ret1 As Long Dim ret2 As Long Const WM_COMMAND As Long = &H111 ret1 = FindWindow("#32770", "ファイルのダウンロード") ret2 = FindWindowEx(ret1, 0, "Button", "保存(&S)") Call SendMessage(ret1, WM_COMMAND, GetDlgCtrlID(ret2), ByVal ret2) ret1 = FindWindow("#32770", "名前を付けて保存") ret2 = FindWindowEx(ret1, 0, "Button", "保存(&S)") Call SendMessage(ret1, WM_COMMAND, GetDlgCtrlID(ret2), ByVal ret2) End Sub ***以上ソース終わり***
- 締切済み
- Visual Basic
- Excel VBAでアプリのウィンドウ名取得
WindowsXP, Excel2007で、ExcelからIE8にキーコードを送りたいです。 ネットで拾った以下のコードにより、 Option Explicit Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Function activate_win(win_name As String) As Long Dim hwindow As Long hwindow = FindWindow(vbNullString, win_name) If hwindow <> 0 Then SetForegroundWindow hwindow activate_win = hwindow End Function Call activate_win("ウィンドウ名") Sendkeys "ABC", True のような形で、メモ帳での動作は確認したのですが、 IEだとウィンドウがアクティブになってくれません。 おそらくウィンドウタイトルを間違えているのだと思われますが、 全角半角などを変えてみたりしても、どう見比べてみても間違いがわかりません。 見た目ではわからない、似た文字だが違うということではないかと思っています。 そこで、開いているアプリのウィンドウ名すべてをメモ帳に書き出すような （あるいは任意のアプリにペーストできるようにするような）コードはないでしょうか？ よろしくお願いします
- ベストアンサー
- その他MS Office製品
- VBAでURLをブラウザで起動させたい
現在、エクセルのVBAのフォーム上のコマンドボタンから、URLをブラウザで起動させたいと思っているのですが、うまくいきません。 インターネット上で以下のプログラムが紹介されていたので試したのですが hwnd の所でエラーとなってしまいます。 Option Explicit Private Declare Function ShellExecute Lib _ "shell32.dll" Alias "ShellExecuteA" _ (ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) As Long Private Sub cmdGO_Click() ShellExecute Me.hwnd, "Open", "http://www.goo.ne.jp/", _ vbNullString, App.Path, 1 End Sub また、エクセルのハイパーリンクを使って、あるセル上に事前に設定しておき、コマンドボタンをクリックした時にそのセルのハイパーリンクを起動させることにしました。しかしブラウザは起動するのですが、ブラウザを閉じるとエクセルの画面が最小化されています。（最大化しようとして右クリックしてもなにも出てきません）同じエクセルファイルをダブルクリックするとやっとエクセルが画面表示されます。 ブラウザを閉じた時に画面上にエクセル画面を表示させたいのですがどのようにすれば良いのでしょう。分かる方が見えましたら宜しくお願いします。 このプログラムは以下のように作成しました Private Sub CommandButton3_Click() Worksheets("データ").Select Range("J18").Select Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True Application.WindowState = xlNormal End Sub ソフトは EXCEL2000です
- ベストアンサー
- Visual Basic
- ブラウザのテキストボックスに文字列を送信したいです
ブラウザで表示したWEBサイトにあるテキストボックス（ファイル名入力用)に 文字を送信したいのですが、そういうことは出来ないでしょうか？ Input TYPE=FILE のフィールドなので、("name").Value = "c:\test.jpg" などのようにしてセットすることができません。 現在下のような方法でとりあえず片っ端から送信してみたのですが、 別のアプリのボタンのTextやウインドウタイトルは多数変更されるのですが 表示中のブラウザの入力フィールドに文字が現れることはありませんでした。 Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As String) As Integer Private Const WM_SETTEXT As Integer = &HC Public Function OutputText(ByVal strMessage As String) As Long For i As Long = 1 To 1000000000 OutputText = SendMessage(i, WM_SETTEXT, 0&, i & strMessage) Next End Function Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click OutputText("変更しました") End Sub VB.NET2003とFramework1.1なのですが、ご教授頂けたら幸いです。よろしくお願い致します。
- ベストアンサー
- Visual Basic
お礼
早速、大変ご丁寧な回答をいただき、 ありがとうございます。 示していただいた参照先についてはまだ確認できていませんが、回答いただいた内容と合わせ、試してみたいと思います。 取り急ぎお礼まで。
補足
教えていただいた参照先のサンプルコードを確認し、 本質問の異常終了の原因がわかりました。 (原因) ４行目のコールバック関数引数の宣言が間違っていました(「ByVal」が抜けていました)。 下記のように修正することでうまく動作することが確認できました。大変お世話になりありがとうございました。 04 Function ListupChildWindows(ByVal hWnd as LongPtr, ByVal lParam as Long) as Boolean