vbaでmsgboxの位置を指定

質問

http://okwave.jp/qa/q5253604.html
を参考に、http://homepage1.nifty.com/rucio/main/technique/MsgBox.htmをやってみたのですが
うまくいきません。

検証はエクセル・アクセス２００７で行いました。

//////////////////////////////////////////////////////////////////
Option Explicit

Dim App As Object

Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _
(ByVal idHook As Long, _
ByVal lpfn As Long, _
ByVal hmod As Long, _
ByVal dwThreadId As Long) As Long

Private Declare Function UnhookWindowsHookEx Lib "user32" _
(ByVal hHook As Long) As Long

Private Declare Function SetWindowPos Lib "user32" _
(ByVal hwnd As Long, _
ByVal hWndInsertAfter As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal cx As Long, _
ByVal cy As Long, _
ByVal wFlags As Long) As Long

Const WH_CBT = 5
Const HCBT_ACTIVATE = 5
Public Const SWP_NOSIZE = &H1 '「サイズを指定しない」オプション
Public Const SWP_NOZORDER = &H4 '「Ｚオーダーを指定しない」オプション
Public Const SWP_NOACTIVATE = &H10

Dim HookHandle As Long '元のCBTProcプロシージャへのハンドル

Dim m_Left As Long 'メッセージボックスのＸ座標
Dim m_Top As Long 'メッセージボックスのＹ座標
Public Sub SetMsgBox(Left As Long, Top As Long)

m_Left = Left
m_Top = Top
HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, App.Hinstance, App.ThreadID)

End Sub
Private Function CBTProc(ByVal nCode As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Dim Ret As Long

If nCode = HCBT_ACTIVATE Then
Ret = SetWindowPos(wParam, 0, m_Left, m_Top, 0, 0, SWP_NOSIZE Or SWP_NOZORDER Or SWP_NOACTIVATE)
Ret = UnhookWindowsHookEx(HookHandle)

End If

CBTProc = Ret

End Function
//////////////////////////////////////////////////////////////////
を標準モジュールに貼りつけました。

Dim App As Objectについては、参考のページにはありませんでしたが
エラーになるので勝手にObjectにしました。

そしてこのコードを書いた標準モジュールに

Sub test()
SetMsgBox 0, 0
MsgBox "この例では左上に表示されます。"
End Sub

を足しました。

そして実行すると、
HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, App.Hinstance, App.ThreadID)
の部分で
オブジェクト変数または With ブロック変数が設定されていません。(Error 91)
になります。

ＶＢＡでの位置の指定方法を教えてください！！！

回答No.2

nicotinism · ベストアンサー

mitarashi さんの回答が無ければ投げ出していました。。
あれぇ？ メッセージボックスではなくてExcelが移動してしまうよ？？
Sub test()
SetMsgBox 0, 0
MsgBox "この例では左上に表示されます。"
End Sub
は、VBE上で実行してはダメなんですね。。
Excelに戻ってマクロの実行で test を行ったら出来ました。

Access2010 だとどうかなと？調べて以下のように加えたら出来ました。
意味は全く理解していません (＾＾ゞ コピペッタンしただけです。
子供が絵本見ながら脳外科の手術を行っているようなものです orz

'VB6 の App.ThreadID の代わり
Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long

'VB6 の App.hInstance の代わり ExcelではApplication.hInstance のみで可、 Access用
Private Const GWL_HINSTANCE = (-6)
Private Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long

'HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, App.hInstance, App.ThreadID) 'VB6
'HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.hInstance, GetCurrentThreadId) 'Excel
HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, GetWindowLong(hWndAccessApp, GWL_HINSTANCE), GetCurrentThreadId) 'Access

お礼

回答ありがとうございました。

回答No.1

mitarashi

xl2010で試してみました。

>Dim App As Objectについては、参考のページにはありませんでしたが
>エラーになるので勝手にObjectにしました。

このAppはエクセル自体を指すので、これでは駄目です。
App.Hinstanceと、App.ThreadIDを取得して指定する必要があります。
昔のバージョンでやったときは、Hinstanceも、ｈWndもAPIを用いて取得する必要があったと記憶しておりますが、現在では若干楽になっておりますね。

下記で動作しました。
HookHandle = SetWindowsHookEx(WH_CBT, AddressOf CBTProc, Application.Hinstance, GetCurrentThreadId)

ここで、GetCurrentThreadIdは、
Private Declare Function GetCurrentThreadId Lib "kernel32.dll" () As Long
を用いています。

最初、Application.hWndから、GetWindowThreadProcessIdで取得したThreadIdでやってみましたが、こちらでは駄目でした。

でもフックをしてまでやることではなく、Userformで実現する方が無難だと存じます。

お礼

フォームを使う手もあるのですね。いろいろ試してみます。ありがとうございました。