HOME > エクセルVBA > サンプル > EnumWindows

EnumWindows


【ファイル名】EnumWindows.xlsm
【バージョン】Ver 1.0.0.4
【作成日】2019年05月20日
【更新日】2021年06月08日
【動作確認】Windows 10
【必要なソフト】Microsoft Excel 2010
【ダウンロード】EnumWindows.zip(ListBox)。ListViewで表示するサンプルは、「EnumWindowsByListView」を参照してください。
【説明】Windows APIのEnumWindowsで、ウィンドウのキャプションを列挙します。コールバック関数を学習します。

ウィンドウ

ウィンドウのハンドル、クラス名、キャプションを列挙します。
ウィンドウのキャプションを列挙のダイアログ

VBAのAddressOfは、標準モジュールのプロシージャーのアドレスを取得します。

下記のマイクロソフトのサイトを参考にしました。
【外部リンク】Docs > Windows > Desktop > API > Windows and Messages > Winuser.h > EnumWindows functionGetClassNameW functionGetWindowTextW functionIsWindowVisible function

customUI14.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="サンプル" insertBeforeMso="TabHome" keytip="S">
        <group id="Group1" label="EnumWindows">
          <button id="ShowFormButton" label="フォームを表示(&S)" supertip="ウィンドウのキャプションを列挙するフォームを表示します。" onAction="onAction" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
このページの上

EnumWindowsModule
Option Explicit

Private Const S_OK = 1

#If Win64 Then
  ' https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-GetClassNamew
  Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameW" (ByVal hWnd As LongPtr, ByVal lpClassName As LongPtr, ByVal nMaxCount As Long) As Long
  
  ' https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-GetWindowTextw
  Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextW" (ByVal hWnd As LongPtr, ByVal lpString As LongPtr, ByVal cch As Long) As Long
  
  ' https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-IsWindowVisible
  Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Long
#Else
  Declare Function GetClassName Lib "user32" Alias "GetClassNameW" (ByVal hWnd As Long, ByVal lpClassName As Long, ByVal nMaxCount As Long) As Long
  Declare Function GetWindowText Lib "user32" Alias "GetWindowTextW" (ByVal hWnd As Long, ByVal lpString As Long, ByVal cch As Long) As Long
  Declare Function IsWindowVisible Lib "user32" (ByVal hWnd As Long) As Long
#End If

Const MAX_BUF_SIZE = 512
'Private rbRibbonUI As IRibbonUI   ' リボン

Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理
'  Set rbRibbonUI = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
'  rbRibbonUI.Invalidate ' リボンの表示を更新します。
End Sub

Sub onAction(control As IRibbonControl) ' 各メニューの処理
  On Error GoTo ErrorHandler ' エラー処理ルーチン
  Select Case control.ID
    Case "ShowFormButton"
      UserForm1.Show vbModal
    Case Else
      Beep ' 警告音
      MsgBox Prompt:=control.ID & "の処理がありません!", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
      Exit Sub
  End Select
  Exit Sub
'-------------------------------------------------------------------------------------------------------------------------
ErrorHandler: ' エラー処理ルーチン
  Beep ' 警告音
  MsgBox Prompt:="エラー番号:" & Err.Number & vbCrLf & Err.Description, Buttons:=vbCritical + vbSystemModal, Title:="エラー"
End Sub

' ウィンドウのキャプションの列挙をリストボックスに追加します。
#If Win64 Then
  ' https://msdn.microsoft.com/en-us/library/ms633498(v=VS.85).aspx
  Function EnumWindowsProc(ByVal hWnd As LongPtr, ByVal lParam As LongPtr) As Long
#Else
  Function EnumWindowsProc(ByVal hWnd As Long, ByVal lParam As Long) As Long
#End If
  Dim strCaption As String
  Dim strClassName As String
  Dim row As Long
   
  strCaption = String(MAX_BUF_SIZE, vbNullChar)
  strClassName = String(MAX_BUF_SIZE, vbNullChar)
  If IsWindowVisible(hWnd) Then
    If GetWindowText(hWnd, StrPtr(strCaption), MAX_BUF_SIZE) <> 0 Then
      UserForm1.ListBox1.AddItem Format(hWnd, "@@@@@@@@") ' Handle
      row = UserForm1.ListBox1.ListCount - 1
      If GetClassName(hWnd, StrPtr(strClassName), MAX_BUF_SIZE) <> 0 Then ' ClassName
        UserForm1.ListBox1.List(row, 1) = StrVBA(strClassName)
      End If
      UserForm1.ListBox1.List(row, 2) = StrVBA(strCaption) ' Caption
    End If
  End If

  EnumWindowsProc = S_OK
End Function

' 指定したヌルで終わる文字列から、vbNullCharの左側の文字列を取得します。
Public Function StrVBA(ByVal EndNullString As String) As String
  Dim p As Long
  
  p = InStr(1, EndNullString, vbNullChar)
  If p > 0 Then
    StrVBA = Left(EndNullString, p - 1)
  Else
    StrVBA = EndNullString ' ■ vbNullCharがない場合は引数をそのまま返します。
'    StrVBA = vbNullString ' ■ 必要に応じて変更してください。
  End If
End Function
このページの上

UserForm1
Option Explicit

#If Win64 Then
  ' https://docs.microsoft.com/en-us/windows/desktop/api/winuser/nf-winuser-EnumWindows
  Private Declare PtrSafe Function EnumWindows Lib "user32" (ByVal lpEnumFunc As LongPtr, ByVal lParam As LongPtr) As Long
#Else
  Private Declare Function EnumWindows Lib "user32" (ByVal lpEnumFunc As Long, ByVal lngParam As Long) As Long
#End If

Private Sub CloseBtn_Click() ' 閉じる
  Unload Me
End Sub

Private Sub GetWindowTitleBtn_Click() ' ウィンドウのキャプションの列挙をリストボックスに追加します。
  ListBox1.Clear
  EnumWindows AddressOf EnumWindowsModule.EnumWindowsProc, 0
End Sub
このページの上