ラベル ExcelVBA-WindowsAPI の投稿を表示しています。 すべての投稿を表示
ラベル ExcelVBA-WindowsAPI の投稿を表示しています。 すべての投稿を表示

2012年8月9日木曜日

[ExcelVBA] EnumWindow関数を使って楽にハンドルを取得したい


正直なところ毎回EnumWindow関数を書くのはしんどいので、関数化して簡単に利用できるようにしておきたい。
ということで、タイトル名を正規表現で渡して、一致する者のハンドルをキーに値にタイトルが入ったものが帰ってくる関数でも作ってみます。

段階を踏まえて書いてみます。
まずは、EnumWindowを使ってただハンドルをデバッグプリントしてみます。
Option Explicit

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Sub GetHWND()
    '必ずエラーになるので止まらないよう処理しておく
    On Error Resume Next
    
    Dim Ret As Long
    Ret = EnumWindows(AddressOf EnumWindowsProc, 0)
    
    On Error GoTo 0
End Sub

Function EnumWindowsProc(ByVal HWND As Long) As Long
    EnumWindowsProc = 1
    
    Debug.Print HWND
End Function

Sub SampleCode()
    'コードを実行してみる
    Call GetHWND
End Sub

3行目:トップレベルにあるウィンドウハンドルを探してくれるEnumWindow関数の宣言です。
6行目:ハンドルを全て見つけた後や、途中でやめた時にエラーとなるのでエラー処理をしておきます
9行目:EnumWindow関数を呼ぶ。
    第一引数はコールバック関数(ハンドルを見つけるたびにOSから呼出される関数)
    第二引数はコールバック関数に受け渡しができる整数の値。特に使う予定がないので0としてます
    戻り値は失敗したら0で成功したらそれ以外なんだと思うけど0しか見たことない…
11行目:エラー解除

コールバック関数側
15行目:戻り値を1(1:次のハンドルを探す,0:他のハンドルは探さず終了)
17行目:ハンドルを出力


次は、ハンドル名からウィンドウタイトルを出力してみます。

Option Explicit

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
    (ByVal HWND As Long, ByVal MSG As Long, _
     ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SendMessageStr Lib "user32.dll" Alias "SendMessageA" _
    (ByVal HWND As Long, ByVal MSG As Long, _
     ByVal wParam As Long, ByVal lParam As String) As Long
Const WM_GETTEXT = &HD
Const WM_GETTEXTLENGTH = &HE
Sub GetHWND()
    '必ずエラーになるので止まらないよう処理しておく
    On Error Resume Next
    
    Dim Ret As Long
    Ret = EnumWindows(AddressOf EnumWindowsProc, 0)
    
    On Error GoTo 0
End Sub

Function EnumWindowsProc(ByVal HWND As Long) As Long
    EnumWindowsProc = 1
    
    'ハンドルに該当する文字列数を取得(注:Null文字は含まない)
    Dim length As Integer
    length = SendMessageStr(HWND, WM_GETTEXTLENGTH, 0, 0)
    length = length + 1 'Null文字分1つ増やす
    
    Dim str As String
    str = String(length, vbNullChar) 'Null文字分一つ多く領域を確保
    
    Dim Ret As Integer
    Ret = SendMessageStr(HWND, WM_GETTEXT, length, str) 'Null文字も含め受取る
    
    Dim WindowTitle As String
    WindowTitle = Left(str, Len(str) - 1)
    
    Debug.Print WindowTitle
End Function

Sub SampleCode()
    'コードを実行してみる
    Call GetHWND
End Sub
変更点の説明
4行目:ウィンドウタイトルの文字数を取得する際のメッセージを送るためSendMessage関数を宣言
7行目:ウィンドウタイトルの文字列を取得する際のメッセージを送るためSendMessageStr関数を宣言
10行目:ウィンドウタイトルの文字列を取得するためのメッセージを設定
11行目:ウィンドウタイトルの文字数を取得するためのメッセージを設定
コールバック関数内
26行目:ウィンドウタイトルの文字数を取得するための変数を宣言
27行目:SendMessage関数にハンドル、文字数取得のメッセージ、第3、第4引数は未使用のため0を指定
    ハンドルからウィンドウタイトルの文字数を取得。
    文字列を取得する際に文字列の最後にNull文字がついてくるが
    ここでは、Null文字を除く文字数が帰ってくる。
28行目:文字列を取得する時Null文字もくっついてくるので1文字分多くしておく
30行目:文字列を受取るための変数を宣言
31行目:文字列+Null文字分に該当する文字数分、メモリを取得しておく
    ここでは、Null文字(vbNullChar)を指定。
34行目:SendMessageStr関数に
    ハンドル、文字列取得のメッセージ、受取る文字数、代入してもらう変数を指定
    ハンドルの文字列を取得
37行目:文字列+Null文字なのでNull文字分切り落とす
39行目:ハンドルの文字列を出力


最終的には、ウィンドウのタイトルを引数に渡すとそれに該当するハンドルと名前をDictionaryに格納して返してくれる関数にしましょう。
ウィンドウのタイトルはあやふやでも指定できるよう、正規表現で指定できることにしましょう。
Option Explicit

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
    (ByVal HWND As Long, ByVal MSG As Long, _
     ByVal wParam As Long, ByVal lParam As Long) As Long
Declare Function SendMessageStr Lib "user32.dll" Alias "SendMessageA" _
    (ByVal HWND As Long, ByVal MSG As Long, _
     ByVal wParam As Long, ByVal lParam As String) As Long
Const WM_GETTEXT = &HD
Const WM_GETTEXTLENGTH = &HE
Dim RegWindowTitle As Object
Dim HWNDs As Object
Function GetHWND(ByVal WindowTitle As String, Optional IgnoreCase As Boolean = False)
    Set HWNDs = CreateObject("Scripting.Dictionary")
    Set RegWindowTitle = CreateObject("VBScript.RegExp")
    RegWindowTitle.Pattern = WindowTitle
    RegWindowTitle.Global = False
    RegWindowTitle.IgnoreCase = IgnoreCase
       
    '必ずエラーになるので止まらないよう処理しておく
    On Error Resume Next
    
    Dim Ret As Long
    Ret = EnumWindows(AddressOf EnumWindowsProc, 0)
    
    On Error GoTo 0
    
    Set GetHWND = HWNDs
    Set HWNDs = Nothing
    Set RegWindowTitle = Nothing
End Function


Function EnumWindowsProc(ByVal HWND As Long) As Long
    EnumWindowsProc = 1

    'ハンドルに該当する文字列数を取得(注:Null文字は含まない)
    Dim length As Integer
    length = SendMessageStr(HWND, WM_GETTEXTLENGTH, 0, 0)
    length = length + 1 'Null文字分1つ増やす
    
    Dim str As String
    str = String(length, vbNullChar) 'Null文字分一つ多く領域を確保
    
    Dim Ret As Integer
    Ret = SendMessageStr(HWND, WM_GETTEXT, length, str) 'Null文字も含め受取る
    
    
    '文字列を出力(NULL文字分1つ削って出力)
    Dim WindowTitle As String, MatchWindowTitle As Object
    WindowTitle = Left(str, Len(str) - 1)
    Set MatchWindowTitle = RegWindowTitle.Execute(WindowTitle)
    If 0 < MatchWindowTitle.Count Then
        HWNDs.Add HWND, WindowTitle
    End If
End Function


Sub SampleCode()
    Dim HWNDs As Object, HWND As Variant
    Set HWNDs = GetHWND("電卓")
    
    For Each HWND In HWNDs
        Debug.Print "[p]" & HWND & "," & HWNDs.Item(HWND)
    Next
End Sub
変更点の説明 12行目:コールバック関数(EnumWindowsProc関数)とは直接変数のやり取りができないので     外で宣言して使いまわす。RegWindowTitleは正規表現用のオブジェクト 13行目:ハンドルをキーにウィンドウタイトルを格納するためのDictionaryオブジェクト 14行目:SubからFunctionに変更。     第一引数は、ウィンドウタイトルを表す正規表現     第ニ引数は、正規表現のIgnoreCaseのプロパティ値。     Optionaryなので明示的に指定しなくても可。その際デフォルトは、大文字小文字の区別はしない。 15行目:Dictionaryオブジェクトの生成 16行目:正規表現オブジェクトの生成 17行目:正規表現を指定 18行目:繰り返し探しださない。 19行目:大文字小文字の識別は第二引数次第。 29行目:戻り値を指定。オブジェクトなのでSetを使っている 30,31行目:オブジェクトの使用後の処理 コールバック関数内 53行目:正規表現に一致するか調べる。 54行目:マッチしたか調べる 55行目:マッチした時は、Dictionaryオブジェクトにハンドルをキーにウィンドウタイトルを値に格納する サンプルコードでは電卓というタイトルがあれば ハンドルとタイトルを取得することにしています。

2012年8月8日水曜日

[ExcelVBA] EnumWindows


■説明
画面上のすべてのトップレベルウィンドウを列挙する関数。
ウィンドウのハンドルを見つけるとそれがトリガーとなり
指定した関数を呼び出します。
指定した関数は、戻り値が1の時だけ次のハンドルを探すプロセスに移ります。

この関数が終了する時は、トップレベルのウィンドウハンドルを全て見つけた時と
指定した関数が0を返した時になります。
いずれもエラーを起こすのでエラー処理が必要となります。



■宣言
Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
lpEnumFunc:ハンドルを見つけた際にハンドルを受け渡す関数名を指定します。
(関数の指定には、AddressOf演算子を使います)
lParam :指定した関数に渡すアプリケーション定義の値を指定
戻り値  :関数が成功すると、0 以外の値が返ります。
※定義としては、上の通りですが0以外の値を見たことがない…

■サンプルコード
まずは、APIの宣言とEnumWindows関数の使用とハンドルが見つかった際に呼び出す関数を作成します
Option Explicit

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Sub SampleCode()
    Dim Ret As Long
    Ret = EnumWindows(AddressOf hogehoge, 0)

    Debug.Print Time
End Sub

Function hogehoge(ByVal hwnd As Long) As Long
    Debug.Print hwnd
End Function

呼び出される関数名をhogehgoeにしてみたので
AddressOf hogehogeとしています。
第二引数は、hogehoge内のデフォルトの値だと
思うのですが何を指定しても変化がないようです…


さて、F8で一つずつ実行していくとEnumWindows関数が一つ目のハンドルを見つけて
hogehoge関数を呼びだし、ハンドルを引数に渡しているのがわかると思います。
その結果、デバッグプリントしています。
ただし、その後関数を抜けるとエラーとなります。

ハンドルを見つけて呼び出した関数の戻り値が1でない限り
エラーを吐いて終了するからです。

では、エラー処理を追加してみます。
まだまだ問題あり。
Option Explicit

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Sub SampleCode()
    On Error Resume Next 'エラーがあっても止めない
    Dim Ret As Long
    Ret = EnumWindows(AddressOf hogehoge, 0)
    On Error GoTo 0 '問題の部分を過ぎたのでエラー処理をもとに戻す
    Debug.Print Time
End Sub

Function hogehoge(ByVal hwnd As Long) As Long
    Debug.Print hwnd
End Function

今度は、一つのハンドルをデバッグプリントした後
エラー処理をしているので、正しく処理が流れています。

ただ、電卓アプリを立ち上げていた時そのハンドルを取得したい
といった場合、該当するアプリのハンドルを見つけるまでは
次々ハンドルを見つけないといけないのでhogehoge関数は
戻り値として1を返すことにしましょう。

Option Explicit

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long
Sub SampleCode()
    '必ずエラーになるので止まらないよう処理しておく
    On Error Resume Next 
    Dim Ret As Long
    Ret = EnumWindows(AddressOf hogehoge, 0)
    On Error GoTo 0 '問題の部分を過ぎたのでエラー処理をもとに戻す
    Debug.Print Time
End Sub

Function hogehoge(ByVal hwnd As Long) As Long
    hogehoge = 1
    Debug.Print hwnd
End Function

これでトップレベルにあるウィンドウのハンドルを全て
デバッグプリントすることができるようになりました。

ただし、ハンドル(数字)の羅列のみだと目的のウィンドウのハンドルがどれかわからないので
ハンドルを元にウィンドウのタイトル名を探すことをしないといけません。
処理を追加します。
Option Explicit

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long

Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal MSG As Long, _
     ByVal wParam As Long, ByVal lParam As Long) As Long

Declare Function SendMessageStr Lib "user32.dll" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal MSG As Long, _
     ByVal wParam As Long, ByVal lParam As String) As Long
Const WM_GETTEXT = &HD
Const WM_GETTEXTLENGTH = &HE

Sub SampleCode()
    '必ずエラーになるので止まらないよう処理しておく
    On Error Resume Next
    Dim Ret As Long
    Ret = EnumWindows(AddressOf EnumWindowsProc, 0)
    On Error GoTo 0 '問題の部分を過ぎたのでエラー処理をもとに戻す
    Debug.Print Time
End Sub

Function EnumWindowsProc(ByVal hWnd As Long) As Long
    EnumWindowsProc = 1
    
    'ハンドルに該当する文字列数を取得(注:Null文字は含まない)
    Dim length As Integer
    length = SendMessageStr(hWnd, WM_GETTEXTLENGTH, 0, 0)
    length = length + 1 'Null文字分1つ増やす
    
    Dim str As String
    str = String(length, vbNullChar) 'Null文字分一つ多く領域を確保
    
    Dim Ret As Integer
    Ret = SendMessageStr(hWnd, WM_GETTEXT, length, str) 'Null文字も含め受取る
    
    '文字列を出力(NULL文字分1つ削って出力)
    Debug.Print Left(str, Len(str) - 1)
End Function
ちなみに、hogehogeからEnumWIndowsProcに名前を変えました。
特に意味はないです…

文字を出力する関係で
SendMessage/SendMessageStr/WM_GETTEXT/WM_GETTEXTLENGTHを追加しました。

2012年8月5日日曜日

[ExcelVBA] SendMessage


■説明
メッセージをウィンドウへ送信する関数
この関数は、指定されたウィンドウのウィンドウプロシージャを呼出、その処理が終わった後で処理を返します。ボタンをクリックして新たなウィンドウを開きそのウィンドウを閉じない限り処理が前に進めないといったケースもあります。
このように同期してほしくない時は、PostMessage関数を使うことで解決できます。

■宣言
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal MSG As Long, _
ByVal wParam As Long, ByVal lParam As Long) As Long
第一引数:メッセージを送りたいハンドルを指定
第ニ引数:メッセージの種類を指定
第三引数:メッセージの種類に応じて指定。
第四引数:メッセージの種類に応じて指定。
※第四引数は、メッセージの種類に応じて違う型の時もあります。
戻り値:メッセージの種類によってことなります。


■サンプルコード
電卓を使ってみます。
まずは、9 * 9 =の計算を行なってみます。
使うメッセージはBM_CLICK
Option Explicit

Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
    (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
     ByVal lpszClass As String, ByVal lpszWindow As String) As Long

Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal msg As Long, _
     ByVal wParam As Long, ByVal lParam As Long) As Long

Const BM_CLICK = &HF5

Sub SampleCode()
    Dim hwnd(3) As Long
    hwnd(0) = FindWindow("SciCalc", "電卓")
    hwnd(1) = FindWindowEx(hwnd(0), 0, "Button", "9")
    hwnd(2) = FindWindowEx(hwnd(0), 0, "Button", "*")
    hwnd(3) = FindWindowEx(hwnd(0), 0, "Button", "=")

    Dim Ret As Long
    Ret = SendMessage(hwnd(1), BM_CLICK, 0, 0)
    Ret = SendMessage(hwnd(2), BM_CLICK, 0, 0)
    Ret = SendMessage(hwnd(1), BM_CLICK, 0, 0)
    Ret = SendMessage(hwnd(3), BM_CLICK, 0, 0)
End Sub
これで電卓のディスプレイには81と表示されているはずです。


今度は、この81と表示されている文字列を受け取ってみます。
使うメッセージはWM_GETTEXT/WM_GETTEXTLENGTH
Option Explicit

Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Declare Function FindWindowEx Lib "user32.dll" Alias "FindWindowExA" _
    (ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
     ByVal lpszClass As String, ByVal lpszWindow As String) As Long

Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal MSG As Long, _
     ByVal wParam As Long, ByVal lParam As Long) As Long

Declare Function SendMessageStr Lib "user32.dll" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal MSG As Long, _
     ByVal wParam As Long, ByVal lParam As String) As Long

Const BM_CLICK = &HF5
Const WM_GETTEXT = &HD
Const WM_GETTEXTLENGTH = &HE

Sub SampleCode()
    Dim hWnd(3) As Long
    hWnd(0) = FindWindow("SciCalc", "電卓")
    hWnd(1) = FindWindowEx(hWnd(0), 0, "Button", "9")
    hWnd(2) = FindWindowEx(hWnd(0), 0, "Button", "*")
    hWnd(3) = FindWindowEx(hWnd(0), 0, "Button", "=")

    Dim Ret As Long
    Ret = SendMessage(hWnd(1), BM_CLICK, 0, 0)
    Ret = SendMessage(hWnd(2), BM_CLICK, 0, 0)
    Ret = SendMessage(hWnd(1), BM_CLICK, 0, 0)
    Ret = SendMessage(hWnd(3), BM_CLICK, 0, 0)
    
    
    Dim hwnd2 As Long '表示部のハンドル取得
    hwnd2 = FindWindowEx(hWnd(0), 0, "Edit", "")
    
    Dim length As Long '表示部の文字列のバイト数を調べる
    length = SendMessage(hwnd2, WM_GETTEXTLENGTH, 0, 0)
    
    Dim DisplayStr As String
    DisplayStr = String(length, vbNullChar)
    Ret = SendMessageStr(hwnd2, WM_GETTEXT, length + 1, DisplayStr)
    
    Debug.Print Left(DisplayStr, Len(DisplayStr) - 1)
End Sub
WM_GETTEXT/WM_GETTEXTLENGTHを追加しました。
ただ、WM_GETTEXTの第四引数は文字列を受取るので
SendMessageの引数と一致していません。
そこで、SendMessageStrという関数名の物を別に作り第四引数をStringにしています。
SendMessageじゃなくてSendMessageStrって何??
と、思ったかたは、「WindowsAPIについて」の■関数についてを参照してください。



最後に電卓を閉じてしまいます。

Option Explicit

Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal msg As Long, _
         ByVal wParam As Long, ByVal lParam As Long) As Long

Const WM_CLOSE = &H10

Sub SampleCode()
    Dim hwnd As Long, Ret As Long
    '操作したいウィンドウのハンドルを調べる
    hwnd = FindWindow("SciCalc", "電卓") 
    
    '調べたハンドルに対し閉じるメッセージを送る
    Ret = SendMessage(hwnd, WM_CLOSE, 0, 0) 
End Sub


メッセージは数多くあるのでここでは紹介しきれないので
後は、探してみてためしてみてください。

[ExcelVBA] FindWindow


■説明
クラス名やウィンドウ名からウィンドウハンドルを探す関数

■宣言
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
第一引数:取得したいウィンドウのクラス名を指定します。
第ニ引数:ウィンドウのタイトルを指定します。
戻り値:関数が成功するとハンドルが返ってきます。失敗すると0が返ってきます

クラス名の調べ方については下記を参考にしてみてください。
Class名の調べ方

■サンプルコード
電卓のハンドルを取得する方法です。
電卓のクラス名はSciCalcです。
Option Explicit

Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Sub SampleCode()
    Dim hwnd As Long
    hwnd = FindWindow("SciCalc", "電卓")
    Debug.Print "電卓のハンドル:" & hwnd
End Sub

クラス名とウィンドウタイトル名の指定のみなのでさほど難しいことはなさそうですね。
ちなみに、複数の電卓を開いている場合、一番手前側にある電卓のハンドルを取得するようです。

[ExcelVBA] Class名の調べ方


FindWindowやFindWindowEXなどの関数を使う際に、クラス名を指定する必要があります。
ツールを使ったクラス名の調べ方をメモしておきます。

自分が知ったツールは2つ。
・WindID
・Winspector(参考記事:窓の杜)


では、これらを使って電卓のクラス名を調べてみたいと思います。
・WinIDの画面


電卓を起動し、タイトルバーあたりにマウスカーソルをあわせてください。
左上にTitleとあるのですが、日本語名は文字化けしています。
そして、その下にClassというところに"SciCalc"これが電卓のクラス名です。

尚、ディスプレイ部分にカーソルを当てると"Edit"
各ボタンにカーソルを当てると"Button"という名前のクラス名がつけられていることがわかります。


・Winspectorの画面


WinIDでは、マウスカーソルをただ重ねればよいのに対し、
Winspectorでは、左上のWindowListのターゲットマークを
調べたい物に対し、ドラッグ&ドロップする必要があります。
そうすると、電卓の情報がのってるところに移動してくれます。
ハンドル、クラス名、タイトル名の順に表示してあります。
つまり、クラス名はSciCalcということになります。

[ExcelVBA] WindowsAPIについて


WindowsAPIを触るにあたって最初に知っておくと少しは楽になるのではないかということをまとめてみました。

■APIとは
あるプラットフォーム(OSやミドルウェア)向けのソフトウェアを開発する際に使用できる命令や関数の集合のこと。【IT用語辞典 e-Wordsより
Excelで言うのであれば、Excelを操作するために、RangeやCellsと言った関数を提供している。
それらを使うことでやりたいことを実現できるわけ。



■WindowsAPIとは
今のを踏まえるとWindowを操作するために、BringWindowToTopやGetClassNameと言った関数を提供しているということになる。では、Windowsって一言で言っているけど何が操作できるのか?ということになるが、日々何気なく操作していることができるようになります。
例えば、マウスであるアプリをクリックすることで最前面に表示したり、そのアプリを移動したりサイズを変更したりといったこと。また、ウィンドウを閉じたりなんてこともWindowsAPIを利用して行うことができます。



■そもそも…
今でこそ、VisualBasicのような言語があるので、何の疑問もなくウィンドウの生成やボタン配置を行なっていますがそれ以前の言語ではどうしてたのでしょうか?
例えばC言語。
マウス操作ぽちぽちでは、ウィンドウを生成できないので、WindowsAPIを利用して簡単なウィンドウを表示するだけでも長いコードを書いていたわけです。それが不便なのでもっと簡単にとVisualBasicのような言語が誕生したわけなので、ExcelVBAからWindowsAPIを触るのはある意味逆行しているようにも見えます。
とはいえ、VisualBasicの誕生で直接WindowsAPIを触る手間が減ったとはいえ、全てのAPIが網羅されているわけではないので、凝ったことを行おうとするとWindowsAPIも触ることになるという感じでしょうか・・・。



■ハンドルとは
WindowsAPIを扱うようになってよく見かけるものの一つに“ハンドル”があります。
ハンドルとは、ウィンドウハンドルとも呼ばれ、ウィンドウやそのウィンドウが管理しているボタン等のオブジェクト全てに付けられた番号のことを指しています。この番号は、立ち上げるたびに重複のない番号がつけられることになっています。
例えば、電卓を立ち上げます。
そして、以下のコードを実行します。
Option Explicit

Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  
Sub SampleCode()
    Debug.Print FindWindow("SciCalc", "電卓")
End Sub

そうすると、今立ち上げた電卓には、2622408という番号がつけられていたということがわかりました。
この番号は、立ち上げるたびに変わる番号なので、皆さんが実行した際には重複することのない番号がつけられています。
そして、この電卓を閉じたい場合は、この番号に対し閉じなさい!
というメッセージを送ることになります。
Option Explicit

Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
        (ByVal hwnd As Long, ByVal msg As Long, _
         ByVal wParam As Long, ByVal lParam As Long) As Long
Const WM_CLOSE = &H10

Sub SampleCode()
    Dim hwnd As Long, Ret As Long
    '操作したいウィンドウのハンドルを調べる
    hwnd = FindWindow("SciCalc", "電卓") 
    
    '調べたハンドルに対し閉じるメッセージを送る
    Ret = SendMessage(hwnd, WM_CLOSE, 0, 0) 
End Sub
このように、ハンドルというものを通して、操作を行ったりしていきます。


また、全てのハンドルは同一階層に存在しているわけでなく、階層上になっています。
各ウィンドウの一番上のハンドルは、トップレベルウィンドウに所属していることになっています。
ひとまず、階層上に管理されているんだ。と認識していればよいと思います。



■関数について
APIを使う前にモジュールの先頭部分で宣言をする必要があります。
例えば…FindWindowという関数を使いたい場合は以下のようにです。
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer

宣言について補足しておきます。
・Declare - お決まりの単語です。変数を宣言する際にDimをつけるのと同じくAPIを利用する際にDeclareから始まります。

・Sub or Function - 値を返さなければSub。値を返せばFunction。

・関数名 - ここではFindWindow

・Lib "***.dll" - 利用したい関数が収められているDLL名を指定。関数名とDLL名はセットになりますね。

・Alias "****" - エイリアスつまり別名です。別名だからって自由に名前つけていいわけじゃありません。
別名なのは、関数名の方が別名なんです…

例えば、電卓のハンドルを取得使用とした場合
ゆく見かける定義をそのまま使うと
Option Explicit

Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
    
Sub SampleCode()
    Dim hwnd As Long
    hwnd = FindWindow("SciCalc", "電卓")
End Sub

ただし、関数名は自由につけることができるので
Option Explicit

Declare Function ハンドルゲッター Lib "user32.dll" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
    
Sub SampleCode()
    Dim hwnd As Long
    hwnd = ハンドルゲッター("SciCalc", "電卓")
End Sub

これでも問題なく動きます。
ちなみに、関数はANSIとUnicode用の2種類があり
9X系はANSIのみでNX系はANSIでもUnicodeでもどちらでも使えるとのこと。
省略した場合は、9X系ではANSI、NX系では、Unicode用の関数が呼び出される。
Aliasに記載されている関数の末尾がAだとANSI用の関数。WだとUnicode用の関数。
なければOSによって使い分けとなる。
ちなみに、Aliasに存在する名前を関数名につけた時Aliasを省略することが可能です。


最後に型についてです。
ExcelVBAで、注意すべきポイントは2つ。
1つ目は、独自の型が指定されている時は、Typeで宣言して用意する必要がある。
例)
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

この関数は、第一引数に渡したハンドルのウィンドウの座標を返す関数です。
左上のx,y座標、右下のx,y座標を返します。
では、どのように返すかというと第二引数をみると
"RECT"という見慣れない型になっています。
この定義を調べるとRECTという型はLEFT/TOP/RIGHT/BOTTOM
という変数を持った構造体であることがわかります。
よって、事前に以下のように変数を宣言しておく必要があります
Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type


では、もう1つのポイントは
String型ですね。
文字列を渡す時は、特に問題ないのですが文字列を受取る時
例えば、ハンドル名からウインドウのタイトルを取得したい時など
こういった時は、変数を渡してそこに格納してもらうことをします。
しかしながら、単純にString型の変数を作って引数に渡せばいいかというとそういうわけではありません。
受取るであろうバイト数より大きめの文字数を代入しておくことで受取る文字+vbNullCharで上書きした値がかえってきます。

具体的に言うと、abcという文字列を受け取ろうとした時
str = String(4, vbNullChar)
としておく必要があります。
そうすることでstrには
a + b + c + vbNullChar が代入されます。
後は、Left,Instr等でvbNullCharの手前までの情報を取得すればよいわけです。


ちなみにvbNullCharである必要はありません。
str = String(5, "*")
こうした場合
* + * + * + * + *
の状態が
a + b + c + vbNullChar + *
となるだけです。
同様にLeft/Instr等でvbNullCharより前を取得すればOKです。

ところで、これから文字をうけとるのに、文字数をどうやって知るんだ?
という話になりますが、不思議に感じるかもしれませんが、ハンドルから
文字数を調べることができるようになっているので事前に取得すればいいだけです。
SendMessage関数でWB_GETTEXTLENGTHメッセージを利用すれば調べられたりします。
わからない時は、あきらかに多い文字数を指定してvbNullCharより手前を取り出すしかないと思います。

2012年5月16日水曜日

[ExcelVBA] GetClassName


■説明
ウィンドウが属するクラスのな前を取得する

■宣言
Declare Function GetClassName Lib "user32" Alias "GetClassNameA"
(ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
第一引数:ウィンドウのハンドルを指定
第二引数:クラス名を格納するための変数を指定
第三引数:APIが返す最大のバイト数を指定(一番最後はNull?)
戻り値:失敗した時0を返します

■サンプルコード
電卓のクラス名はSciCalcなのでGetClassNameで取得して確認してみましょう。
Option Explicit

Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
    (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Sub SampleCode()
    '電卓のクラス名がSciCalcであることをGetClassNameを使って確かめてみる
    Dim hwnd As Long
    hwnd = FindWindow("SciCalc", "電卓")
    
    Dim ClassName As String, Ret As Long
    ClassName = String(255, vbNullChar) 'クラス名が何文字か不明なので大きめの領域を確保しておく

    Ret = GetClassName(hwnd, ClassName, 255)

    Debug.Print Left(ClassName, InStr(ClassName, vbNullChar) - 1)
End Sub
実行すると、SciCalcの文字が取得できます。
これで、FindWindows関数を使いたいけどクラス名がわからなくて使えない…
って場合に、EnumWindowでウィンドウ名から事前にハンドルを取得し
GetClassNameでクラス名を調べてしまえば、FindWindow関数で
ハンドルを取得することも可能になるわけですね。

2011年12月26日月曜日

[ExcelVBA] GetWindowRect

 
■説明
ウィンドウ全体の座標を取得する関数

■宣言
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
第一引数:ウィンドウのハンドルを指定
第二引数:ウィンドウのtop/right/bottom/leftの値を格納するための構造体を指定します
例)
Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
戻り値:失敗した時0を返します

■サンプルコード
では、サンプルとして、デスクトップのサイズを大きさを出してみます。
デスクトップのハンドルを取得するには、 GetDesktopWindow関数を使用すれば取得できます。
GetDesktopWindow関数について
Option Explicit

Declare Function GetDesktopWindow Lib "user32" () As Long

Sub SampleCode1()
    Dim hwnd As Long
    hwnd = GetDesktopWindow()
    
    Debug.Print hwnd
End Sub
説明するまでもない簡単なコードです。
ただし、ウィンドウのハンドルがわかっただけでは、うれしくもないので
他の関数に渡して活用してみます。
Option Explicit

Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Sub SampleCode()
    Dim hwnd As Long
    hwnd = GetDesktopWindow()
    
    Dim Re As RECT
    Dim Result As Long
    Result = GetWindowRect(hwnd, Re)
    
    Debug.Print "左上(x, y) = (" & Re.Left & ", " & Re.Top & ")"
    Debug.Print "右下(x, y) = (" & Re.Right & ", " & Re.Bottom & ")"
    
    Debug.Print "Width :" & (Re.Right - Re.Left)
    Debug.Print "Heihgt:" & (Re.Bottom - Re.Top)
End Sub
実行結果例:
左上(x, y) = (0, 0)
右下(x, y) = (1920, 1080)
Width :1920
Heihgt:1080

今度は、電卓を起動して、電卓のウィンドウ座標を取得してみます。
Option Explicit

Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Sub SampleCode()
    Dim hwnd As Long
    hwnd = FindWindow("SciCalc", "電卓")
    
    Dim Re As RECT
    Dim Result As Long
    Result = GetWindowRect(hwnd, Re)
    
    Debug.Print "左上(x, y) = (" & Re.Left & ", " & Re.Top & ")"
    Debug.Print "右下(x, y) = (" & Re.Right & ", " & Re.Bottom & ")"
    
    Debug.Print "Width :" & (Re.Right - Re.Left)
    Debug.Print "Heihgt:" & (Re.Bottom - Re.Top)
End Sub
実行結果例:
 左上(x, y) = (66, 87)
 右下(x, y) = (368, 332)
 Width :302
 Heihgt:245


 今度は、関数電卓モードに切り替えて実行してみます。
 左上(x, y) = (66, 87)
 右下(x, y) = (625, 384)
 Width :559
 Heihgt:297
 

[ExcelVBA] GetDesktopWindow

 
■説明
デスクトップウィンドウのハンドルを取得する関数です。

■宣言
Declare Function GetDesktopWindow Lib "user32" () As Long
戻り値:ウィンドウハンドル

■サンプルコード
Option Explicit

Declare Function GetDesktopWindow Lib "user32" () As Long

Sub SampleCode1()
    Dim hwnd As Long
    hwnd = GetDesktopWindow()
    
    Debug.Print hwnd
End Sub
説明するまでもない簡単なコードです。
ただし、ウィンドウのハンドルがわかっただけでは、うれしくもないので
他の関数に渡して活用してみます。

例えば…デスクトップサイズの取得。
Option Explicit

Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long

Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Sub SampleCode2()
    Dim hwnd As Long
    hwnd = GetDesktopWindow()
    
    Dim Re As RECT
    Dim Result As Long
    Result = GetWindowRect(hwnd, Re)
    
    Debug.Print "Width :" & (Re.Right - Re.Left)
    Debug.Print "Heihgt:" & (Re.Bottom - Re.Top)
End Sub
 

[ExcelVBA] BringWindowToTop

 
■説明
ウィンドウをZオーダーの先頭に持ってくる関数

■宣言
Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
第一引数:ウィンドウのハンドルを指定
戻り値:失敗した時0を返します

■サンプルコード
サンプルでは、電卓アプリを手前に表示するコードです。
FindWindow関数を使ってハンドルを取得しています。
Option Explicit

Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long
Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Integer

Sub SampleCode()
    Dim hwnd As Long
    hwnd = FindWindow("SciCalc", "電卓")
    
    Dim Ret As Integer
    Ret = BringWindowToTop(hwnd)
    
    If Ret = 0 Then MsgBox "アクティブにできませんでした"

    '参考までに戻り値を表示してみる
    Debug.Print Ret '成功したら1が戻ってきた
End Sub


ExcelVBAで同様のことをするには、AppActivate関数を使うとよいですね。
第一引数には、ウィンドウのタイトルかプロセス値のどちらかを指定する必要があります。
存在しない場合エラーとなるため、エラー処理が必要になります。
そのまま終了させるならOn Error
ウィンドウが表示されるまで時間がかかるから
ループで待つのなら、On Error Resume Nextで
処理を止めない等のやり方ですね。
(ループさせる時は、タイムアウトさせる必要もあり)
Option Explicit

Sub SampleCode2()
    On Error Resume Next
    AppActivate ("電卓")
    If Err.Number <> 0 Then MsgBox "アクティブにできませんでした"
    GoTo 0
End Sub


Sub SampleCode3()
    Dim TimeOut As Integer: TimeOut = 5 '存在しない時は、5秒でループを抜ける
    Dim BaseTime As Double: BaseTime = Timer()
    
    On Error Resume Next
    Do
        On Error GoTo 0 'エラー初期化
        AppActivate ("電卓")
        
        'エラーが無ければ抜ける
        If Err.Number = 0 Then Exit Do
        
        'タイムアウトチェック
        If TimeOut < (Timer() - BaseTime) Then
            MsgBox "タイムアウトしました"
            Exit Do
        End If
        
        'Timer関数は0時になると値が0に戻るので
        '0時をまたぐとTimer() - BaseTimeは負の値となり
        'いつまでもタイムアウトしないので負の値だと別に
        'エラー表示する必要がある。
        If (Timer() - BaseTime) < 0 Then
            MsgBox "0時またぎエラー"
            Exit Do
        End If
    Loop
    
End Sub
 

[ExcelVBA] WindowsAPI 一覧


■はじめに
WindowsAPIを学習するにあたって、日々わかったことをまとめていく予定です。
まずは、学習し始めに知っておくと少しは楽になるかもしれない内容をまとめたのでそちらからどうぞ
WindowsAPIについて

※注:コードの検証は、XP、Office2003でしか行なっておりません。

■API一覧
API内容
BringWindowToTopウィンドウをZオーダーの先頭に持ってくる
EnumWindows画面上のすべてのトップレベルウィンドウを列挙する
FindWindowクラス名やウィンドウ名からウィンドウハンドルを取得
FindWindowEx親ハンドル、クラス名、ウィンドウ名から子ハンドルを取得
GetClassNameウィンドウが属するクラスの名前を取得
GetDesktopWindowデスクトップのハンドルを取得
GetWindowRectウィンドウ全体の座標を取得
SendMessageメッセージをウィンドウへ送信
Sleepスレッドの実行を指定の時間だけ中断する


■宣言一覧
Declare Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Long

Declare Function EnumWindows Lib "user32.dll" (ByVal lpEnumFunc As Long, lParam As Long) As Long

Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) 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 GetDesktopWindow Lib "user32" () As Long

Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Declare Function MoveWindow Lib "user32.dll" _
        (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

Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal MSG As Long, _
     ByVal wParam As Long, ByVal lParam As Long) As Long

Declare Sub Sleep Lib "Kernel32" (ByVal dwMilliseconds As Long)


'■SendMessageで使用
Const BM_CLICK = &HF5       'Clickする        第三:0, 第四:0, Ret:なし
Const WM_GETTEXT = &HD       'Textを取得する  第三:受取る文字数, 第四:受取る為の変数
Const WM_GETTEXTLENGTH = &HE '文字数を取得する 第三:0, 第四:0, Ret:バイト数
Const WM_CLOSE = &H10            '閉じる           第三:0, 第四:0, Ret:なし


■さんぷるこーど
EnumWindow関数を使って楽にハンドルを取得したい