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

質問

メッセージボックスを表示させた際
OKボタンや、YES/NOボタン上にポインタを移動させるコードを教えて頂けませんか？

「VBA msgbox ポインタ 移動」などで検索したのですが
どうしてもヒットしませんでした。
どうぞよろしくお願いいたします。

回答No.5

KenKen_SP · ベストアンサー

やってみたらできた。が、実用的でないので実験扱いということで。

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

お礼

回答ありがとうございます！！
忙しくてお礼がおくれてごめんなさい！！
コード記述していただいてありがとうございます。
まだ時間がなくて試せないのですが、
落ち着いたら、ぜひテストさせていただきます！
ただ、他の回答者様のお礼欄にも書いたのですが
こんなに大変な事だとは知らずに質問してしまいまして、
現時点ではポインタの移動はさせない方向でいます。
せっかく記述していただいたのに、ごめんなさい。
でも、私の勉強に使用させて頂きますね。
本当にありがとうございました！！

回答No.6

imogasi

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

お礼

いえ、とてもありがたかったです！！
始めてみるワードもあり、勉強になります！
丁寧に訂正いただき、ありがとうございました＾＾

***回答者皆様***
皆様回答くださり、本当に感謝しております。
お礼が遅くなって申し訳ございませんでした。
今回は、実際にコードを記述くださったKenKenSP様に20P
最初に回答くださったDexMachina様に10P　とさせていただきます。
また質問させていただく際は、どうぞよろしくお願いいたします。

この場をお借りしての報告、すみませんでした。

回答No.4

Wendy02

こんにちは。

>メッセージボックスを表示させた際OKボタンや、YES/NOボタン上にポインタを移動させるコードを教えて頂けませんか？

#2さんのおっしゃるように、それらのボタンを調べてみましたら常に定位置のようですから、最初に、マウス・カーソルを動かしておいてから、MsgBox を立ち上げるというようなスタイルになると思います。しかし、そこまでを作り上げる必要性があるのか、好事家ならともかく、実務上は疑問に感じます。ただし、既に、ヒントは出されていますので、作成は可能だと思います。(SetCursorPos)

もしも、ある種のデモのようなスタイルにするなら、

UWSC のような外部ツールで動かしたほうが楽ではないでしょうか？
http://www.uwsc.info/

現実に、マウスカーソルを動かして、ユーザ・フレンドリというスタイルにするというのは、Excelという汎用型・既成アプリケーションからすると、ありえないような動作のような気がします。

もしも、Yes/No の二者択一など、選択肢を限定させるなら、ユーザーフォームやコントロールツールのオブジェクトでマウス・イベントの、右、左ボタンを検知させるコードを設けるなど、全体的に作りを変えたほうがよいと思います。

お礼

アドバイスありがとうございます！！
お礼が遅くなってしまってごめんなさい！！！
メジャーな動作だと勘違いしてしまいました・・・。
駆使すれば作成は可能との事ですが、
確かにそこまでする必要はありませんね＾＾；
いつもほんとにありがとうございます。
ちなみに、リンクを拝見しましたが、
外部ツールとは、フリーソフトなどのことでしょうか？
いろいろ調べてみますね！

回答No.3

imogasi

質問の意図を捉えられていないかもしれないが
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 などのことですかな。

お礼

アドバイスありがとうございます！
コードの「ans」は、初めて見ました。初心者ですみません＾＾；
新しい知識として、勉強したいと思います！
Excelに、コードを貼り付けて実行してみましたが、
わかりませんでした。
せっかく記述してくださったのに、申し訳ございません。
でも、とても勉強になります。
本当にありがとうございました！

回答No.2

gatyan

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

お礼

アドバイスありがとうございます！
回答者NO1さんの所にも書いたのですが、メジャーな動作だと思っていました＾＾；
いろいろ考えてくださって、本当に感謝しております。
今回は自分のスキルにあわせ、難しいことはやめておこうかと思っていますが、
皆さんがアドバイスくださった内容を勉強して、スキルアップに励みます！！
本当にありがとうございました。

回答No.1

DexMachina

すみません、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でそれを実行して、ということもできるのかもしれません(汗)

お礼

アドバイスありがとうございます！
以前フリーのExcel住所録ソフトで、メッセージボックスが出たときに
ポインタがちゃんとボタンを指していたのが、とても便利だったので
メジャーなものだと思っていました。

代替策の１、２とても参考になりました。
本当にありがとうございます。