プロが教えるわが家の防犯対策術!

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)
以上、よろしくお願いします。

A 回答 (3件)

以前に、Yukiさんから教えていただいたモノです。


解説出来るだけのスキルはいまだに持ち合わせておりませぬ orz
Excel2010 & 32bit バージョンでの確認ですが、多分2003でも機能するハズです。
※サイトの都合上、タブインデントの代わりに全角スペースにしています。


' すべてのウィンドウ
Declare Function EnumWindows Lib "user32.dll" _
            (ByVal lpEnumFunc As Long, lParam As Any) As Long
Public Declare Function IsWindowVisible Lib "User32" _
            (ByVal Hwnd As Long) As Long

' ウィンドウのクラス名
Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" _
            (ByVal Hwnd As Long, ByVal lpClassName As String, _
             ByVal nMaxCount As Long) As Long

' ウィンドウテキスト
Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" _
            (ByVal Hwnd As Long, ByVal lpString As String, _
             ByVal nMaxCount As Long) As Long
'親ウインドウの
Public Declare Function GetParent Lib "User32" _
            (ByVal Hwnd As Long) As Long

'ウインドウ文字列の長さ
Public Declare Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" _
            (ByVal Hwnd As Long) As Long

'ウインドウ設定値
Public Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" _
            (ByVal Hwnd As Long, ByVal nIndex As Long) As Long

Public Const GWL_STYLE = (-16)
Public Const WS_SYSMENU = &H80000
Public Const WS_BORDER = &H800000

' コールバック関数
Function EnumWindowsProc(ByVal Hwnd As Long, lParam As Worksheet) As Long
  
Dim wks           As Worksheet
Dim strWindowClassNameBuff As String * 128
Dim strWindowTextBuff   As String * 516
Dim lngRtnCode       As Long
Dim lngStyle        As Long
Dim lngRow         As Long

  '表示状態
  If IsWindowVisible(Hwnd) = 0 Then GoTo EnumPass
  '親ウインドウ
  If GetParent(Hwnd) <> 0 Then GoTo EnumPass
  'タイトルバー文字長さ
  If GetWindowTextLength(Hwnd) = 0 Then GoTo EnumPass
  lngStyle = GetWindowLong(Hwnd, GWL_STYLE)
  'システムメニュー
  If Not lngStyle And WS_SYSMENU Then GoTo EnumPass
  '境界線
  If Not lngStyle And WS_BORDER Then GoTo EnumPass

  Set wks = lParam
  lngRow = wks.Range("A65536").End(xlUp).Row + 1
  
  ' ウィンドウハンドル
  wks.Cells(lngRow, 1).NumberFormatLocal = "@"
  wks.Cells(lngRow, 1).Value = CStr(Right("00000000" & Hex(Hwnd), 8))

  ' クラス名をバッファに
  lngRtnCode = GetClassName(Hwnd, strWindowClassNameBuff, _
               Len(strWindowClassNameBuff))
  ' クラス名表示
  wks.Cells(lngRow, 2).Value = Left(strWindowClassNameBuff, _
                 InStr(strWindowClassNameBuff, vbNullChar) - 1)

  ' タイトルバーテキストをバッファに
  lngRtnCode = GetWindowText(Hwnd, strWindowTextBuff, Len(strWindowTextBuff))

  ' タイトルバーテキスト表示
  wks.Cells(lngRow, 3).Value = Left(strWindowTextBuff, InStr(strWindowTextBuff, _
                vbNullChar) - 1)

  ' 列挙を継続
EnumPass:
  EnumWindowsProc = True
End Function

Sub TEST()
  Dim lngRtnCode As Long
  ' シートクリア
  Worksheets(1).Cells.Clear
  Worksheets(1).Range("A1").Resize(, 3).Value _
                = Array("WindowHandle", "ClassName", "WindowText")

  ' トップレベルウィンドウを列挙
  lngRtnCode = EnumWindows(AddressOf EnumWindowsProc, Worksheets(1))

  Worksheets(1).Columns("A:C").AutoFit
End Sub
    • good
    • 1
この回答へのお礼

ありがとうございました。
できました。

ですが、また問題が出ました。
リモートデスクトップの中のウィンドウハンドルは取得できないのでしょうか。
別に質問を立てたいと思います。
今回はありがとうございました。

お礼日時:2013/08/16 09:34

「VBA EnumWindows」でググったらいいのでは。

    • good
    • 0

VBAはVisual Basic 6.0 のサブセットなので


当然、「Delegate」は使えません。

この回答への補足

回答ありがとうございました。
Visual Basic 6.0 サブセットなのですか。
ついでにもうひとつ。
確認ですが、Excel2013のVBAも同じなのですね?

補足日時:2013/08/11 17:11
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!