Ｅｘｃｅｌ　ＶＢＡ　msgboxについて

Question

メッセージボックスを表示させた際
OKボタンや、YES/NOボタン上にポインタを移動させるコードを教えて頂けませんか？

「VBA msgbox ポインタ 移動」などで検索したのですが
どうしてもヒットしませんでした。
どうぞよろしくお願いいたします。

KenKen_SP · Accepted Answer

やってみたらできた。が、実用的でないので実験扱いということで。

MsgBox のボタンは Prompt の長さで位置が変動するため、正確に
カーソルを移動したい場合は、Msgbox を表示した後でボタン位置
の座標計算をしなければなりません。デスクトップ解像度でも変化
しそうですね。

ご参考まで。

' // 標準モジュール

Option Explicit

Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long
Private Declare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" ( _
　　　　ByVal lpModuleName As String) As Long
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 CallNextHookEx Lib "user32" ( _
　　　　ByVal hHook As Long, _
　　　　ByVal nCode As Long, _
　　　　ByVal wParam As Long, _
　　　　ByRef lParam As Any) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" ( _
　　　　ByVal hWnd As Long, _
　　　　ByVal lpClassName As String, _
　　　　ByVal nMaxCount As Long) As Long
Private Declare Function GetDlgItem Lib "user32.dll" ( _
　　　　ByVal hDlg As Long, _
　　　　ByVal nIDDlgItem As Long) As Long
Private Declare Function GetWindowRect Lib "user32.dll" ( _
　　　　ByVal hWnd As Long, _
　　　　ByRef lpRect As RECT _
) As Long
Private Declare Function SetCursorPos Lib "user32.dll" ( _
　　　　ByVal x As Long, _
　　　　ByVal y As Long) As Long

Private Type POINTAPI
　　　　x　　　 As Long
　　　　y　　　 As Long
End Type
Private Type RECT
　　　　Left　　As Long
　　　　Top　　 As Long
　　　　Right　 As Long
　　　　Bottom　As Long
End Type

' // Msgbox Ctrl ID
Public Enum MSGBOXCTRLID
　　　 CTRLID_OK = &H1
　　　 CTRLID_CANCEL = &H2
　　　 CTRLID_ABORT = &H3
　　　 CTRLID_RETRY = &H4
　　　 CTRLID_IGNORE = &H5
　　　 CTRLID_YES = &H6
　　　 CTRLID_NO = &H7
End Enum

Private Const MAX_PATH As Long = 256
Private Const WH_CBT = 5
Private Const HCBT_ACTIVATE = 5
Private Const HC_ACTION = 0

Private hHook　　　　As Long
Private mlMoveCurPos As Long

' // カーソル移動機能（InteliPoint の SnapItもどき）
' // のあるメッセージボックス関数
Public Function MsgboxEx( _
　　　 ByVal Prompt As String, _
　　　 Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _
　　　 Optional ByVal Title As String = "Microsoft Excel", _
　　　 Optional ByVal MoveCurPos As MSGBOXCTRLID = 0 _
) As VbMsgBoxResult

　　Dim hModule　As Long
　　Dim ThreadID As Long
　　
　　ThreadID = GetCurrentThreadId()
　　hModule = GetModuleHandle(vbNullString)
　　mlMoveCurPos = MoveCurPos
　　hHook = SetWindowsHookEx(WH_CBT, _
　　　　　　　　　　　　　　 AddressOf MsgboxHookProc, _
　　　　　　　　　　　　　　 hModule, _
　　　　　　　　　　　　　　 ThreadID)
　　MsgboxEx = MsgBox(Prompt, Buttons, Title)
　　UnhookWindowsHookEx hHook

End Function

' // CallBack
Private Function MsgboxHookProc( _
　　　　ByVal nCode As Long, _
　　　　ByVal wParam As Long, _
　　　　ByVal lParam As Long _
) As Long
　　
　　Dim lReturn　　As Long
　　Dim sClassName As String
　　Dim hWnd　　　 As Long
　　Dim uRect　　　As RECT
　　Dim x　　　　　As Long
　　Dim y　　　　　As Long
　　
　　If nCode < HC_ACTION Then
　　　　MsgboxHookProc = CallNextHookEx(hHook, nCode, wParam, lParam)
　　　　Exit Function
　　End If
　　
　　sClassName = Space$(MAX_PATH)
　　
　　If nCode = HCBT_ACTIVATE Then
　　　　lReturn = GetClassName(wParam, sClassName, Len(sClassName))
　　　　' // Dialog Class Name:= #32770
　　　　If Left$(sClassName, lReturn) = "#32770" Then
　　　　　　' // 目的ボタンのハンドルを取得する.引数の指定ミス等でハンドル
　　　　　　' // 取得に失敗したら Msgbox のウインドウハンドルに置き換え
　　　　　　hWnd = GetDlgItem(wParam, mlMoveCurPos)
　　　　　　If Not hWnd > 0 Then
　　　　　　　　hWnd = wParam
　　　　　　End If
　　　　　　' // 取得したハンドルのボタン（またはウインドウ）の中央
　　　　　　' // スクリーン座標を求めて、カーソルを移動させる
　　　　　　Call GetWindowRect(hWnd, uRect)
　　　　　　With uRect
　　　　　　　　 x = .Left + Int((.Right - .Left) / 2)
　　　　　　　　 y = .Top + Int((.Bottom - .Top) / 2)
　　　　　　End With
　　　　　　Call SetCursorPos(x, y)
　　　　End If
　　End If
　　
　　CallNextHookEx hHook, nCode, wParam, lParam

End Function


' // 使い方のサンプルコード（動作確認用）
Sub Sample()
　　
　　Dim iRes　　As Integer
　　Dim sPrompt As String
　　
　　' // テスト用に長いプロンプトを用意
　　sPrompt = String$(500, "あ")
　　' // メッセージボックス表示
　　iRes = MsgboxEx(sPrompt, _
　　　　　　　　　　vbYesNoCancel + vbDefaultButton3 + vbQuestion, _
　　　　　　　　　　"テストです", CTRLID_CANCEL)
　　Select Case iRes
　　　　Case vbYes:　　MsgboxEx "Press Yes Button.", , , CTRLID_OK
　　　　Case vbNo:　　 MsgboxEx "Press No Button.", , , CTRLID_OK
　　　　Case vbCancel: MsgboxEx "Press Cancel Button.", , , CTRLID_OK
　　End Select
　　
End Sub

imogasi · Answer

#3です。
質問の主旨と違っていたようで、すみません。
私が回答したのは、Msgboxでボタンを２つなり表示したとき、どちらのボタンをDefaltボタン（そのままでEnterキーを押すと有効になる方のボタンを指定する）の設定にするかの質問と受け取りました。

Wendy02 · Answer

こんにちは。

>メッセージボックスを表示させた際OKボタンや、YES/NOボタン上にポインタを移動させるコードを教えて頂けませんか？

#2さんのおっしゃるように、それらのボタンを調べてみましたら常に定位置のようですから、最初に、マウス・カーソルを動かしておいてから、MsgBox を立ち上げるというようなスタイルになると思います。しかし、そこまでを作り上げる必要性があるのか、好事家ならともかく、実務上は疑問に感じます。ただし、既に、ヒントは出されていますので、作成は可能だと思います。(SetCursorPos)

もしも、ある種のデモのようなスタイルにするなら、

UWSC のような外部ツールで動かしたほうが楽ではないでしょうか？
http://www.uwsc.info/

現実に、マウスカーソルを動かして、ユーザ・フレンドリというスタイルにするというのは、Excelという汎用型・既成アプリケーションからすると、ありえないような動作のような気がします。

もしも、Yes/No の二者択一など、選択肢を限定させるなら、ユーザーフォームやコントロールツールのオブジェクトでマウス・イベントの、右、左ボタンを検知させるコードを設けるなど、全体的に作りを変えたほうがよいと思います。

imogasi · Answer

質問の意図を捉えられていないかもしれないが
Sub test01()
ans = MsgBox(msg, vbCritical + vbYesNo + vbDefaultButton2, "Are you SURE?????")
MsgBox ans
ans = MsgBox("Do you want to save changes?", vbYesNo + vbExclamation + vbDefaultButton1, _
"Front Page ")
MsgBox ans
End Sub
の
vbDefaultButton1やvbDefaultButton2 などのことですかな。

gatyan · Answer

マウスの位置は、Windows API の SetCursorPos を使ってできるので、VBAでするなら
ボタンの位置を予測して、マウスポインタを先に移動させてから Msgbox を表示させる（ダイアログボックスは、画面中央に表示されるので、とりあえず中央に移動で誤魔化しておくとか）
か
ユーザーフォームでMsgboxもどきを作って、ActivateやGotFocusなどのイベントで位置を計算してマウスを動かす
ということになると思います
…フォームの位置とフォーム内のボタンの位置からマウスを移動すべき座標が計算できます
でなければ、#1のかたの方法 デフォルトボタンの指定とマウスのプロパティの設定で移動するようにするになると思います

DexMachina · Answer

すみません、VBAでのマウスポインタの移動方法については知らないので、代替策のアドバイスということで・・・(汗) <代替策1> MsgBox関数の第2引数を、「vbYesNo」ではなく「vbYesNo+vbDefaultButton2」とする。 (MsgBoxが表示された時点でYes/NoボタンのNoボタンが選択された状態にする場合。　「+vbDefaultButton○」(「○」は1～4の整数)を加算すると、第○ボタンが選択された　状態でMsgBoxが表示されます) マウスカーソルは移動しないので、その場でマウスボタンを左クリックしてもMsgBoxへの応答にはならないので、マウスでの作業性は現状から改善されませんが、キーボードの Enterキーを押せば選択済みのボタンが押されます。 <代替策2> Windowsのマウスの設定を変更する； http://allabout.co.jp/computer/windows/closeup/CU20041015A/index.htm こちらの場合、既定のボタン(上の代替策1を使用してNoボタンを既定にすれば同ボタン)の上にマウスカーソルが移動します。但し、Windowsの機能を使用しているので、他のアプリケーションにも影響します。・・・この辺りの設定を変更するAPIか何かをご存知の方なら、Excelの立ち上げ時に VBAでそれを実行して、ということもできるのかもしれません(汗)

Ｅｘｃｅｌ ＶＢＡ msgboxについて

やってみたらできた。

#3です。

こんにちは。

質問の意図を捉えられていないかもしれないが

マウスの位置は、Windows API の SetCursorPos を使ってできるので、VBAでするなら

すみません、VBAでのマウスポインタの移動方法については知らないので、代替策の

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

Ｅｘｃｅｌ　ＶＢＡ　msgboxについて