マウスイベントが動かない

このQ&Aのポイント
  • マウスイベントが正常に動作しない問題について質問があります。
  • エクセルシートのダブルクリックイベントでマウス左クリックを呼び出していますが、一部のマウスイベントが動作しない現象が発生しています。
  • タイマーの遅延やモジュールにコードを追加するなど、さまざまな試みをしたが解決しません。どこに問題があるか教えてください。
回答を見る
  • ベストアンサー

マウスイベントが動かない

エクセルシートのダブルクリック イベントで  Call マウス左クリック  とします。 ret = SetCursorPos(929, 12) カーソル移動と SendKeys " 12345" は動くのですが mouse_event 2, 0, 0, 0, 0 '左ダウン mouse_event 4, 0, 0, 0, 0 '左アップ この二つが 動いてくれません。 遅延させるタイマー入れたり、するのですが同じです。 MODULE の中に入れたり、シートの中に入れても 同じです。 どこが、問題なのでしょうか よろしくどうぞ Sub タイミング() stime = gettickcount Do While gettickcount - stime < 1000 DoEvents Loop Sub マウス左クリック() ret = SetCursorPos(929, 12) mouse_event 2, 0, 0, 0, 0 '左ダウン mouse_event 4, 0, 0, 0, 0 '左アップ ret = SetCursorPos(309, 282) SendKeys " 12345" ret = SetCursorPos(309, 320) SendKeys " 12345" SendKeys " {ENTER}" SendKeys " %(RY)", True Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Public Type POINTAPI X As Long Y As Long End Type  ’位置取得 '------------------------------------------------------------------ Private Declare Sub mouse_event Lib "user32" _ (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As _ Long, ByValcButtons As Long, ByVal dwExtraInfo As Long) Public Declare Function SetCursorPos Lib "user32" _ (ByVal X As Long, ByVal Y As Long) As Long

質問者が選んだベストアンサー

  • ベストアンサー
  • DreamyCat
  • ベストアンサー率56% (295/524)
回答No.2

すべてを標準モジュールに書いてみました。 実行開始はシート1に置いた「角丸四角形」にマクロの登録をして、これをクリックします。 Option Explicit Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Public Type POINTAPI X As Long Y As Long End Type '位置取得 '------------------------------------------------------------------ Private Declare Sub mouse_event Lib "user32" _ (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As _ Long, ByValcButtons As Long, ByVal dwExtraInfo As Long) Public Declare Function SetCursorPos Lib "user32" _ (ByVal X As Long, ByVal Y As Long) As Long Public Declare Function GetTickCount Lib "kernel32" () As Long Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub 角丸四角形1_Click() Call タイミング Call マウス左クリック End Sub Sub タイミング() 'ここはわずらわしいのでSleepに変えました。 'Dim stime As Long 'stime = GetTickCount 'Do While GetTickCount - stime < 1000 'DoEvents 'Loop Sleep 1000 End Sub Sub マウス左クリック() Dim ret As Long ret = SetCursorPos(929, 12) mouse_event 2, 0, 0, 0, 0 '左ダウン mouse_event 4, 0, 0, 0, 0 '左アップ 'ret = SetCursorPos(309, 282) Sleep 500 SendKeys " 12345" ret = SetCursorPos(309, 320) SendKeys " 12345" SendKeys " {ENTER}" SendKeys " %(RY)", True DoEvents: DoEvents: DoEvents End Sub これでペイントの右上のボタンをクリックさせ セルに12345を2回表示させました。 2010版のせいかSendKeys " %(RY)", Trueは校閲らしいのですがYがわかりませんでした。 Excelのどの版でも正常に動作すると思いますので、理解を進めてください。 なおシートのセルをダブルクリックして開始させる場合は 上記の角丸四角形・・のところを変えます。 (あるいはそのまま残しておけばどちらからでも実行できます。) Worksheet_BeforeDoubleClickイベントを使い下記のようにします。 Option Explicit Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Call タイミング Call マウス左クリック End Sub

007itochan
質問者

お礼

ありがとうございます。 クリックイベントの前に少し 時間を入れてやると OKでした。 お世話様でした。感謝

その他の回答 (1)

  • DreamyCat
  • ベストアンサー率56% (295/524)
回答No.1

SetCursorPos(929, 12) この座標は正しいですか。 古いXP機の1024x800モニターで、該当のWindowが最大化されている状態の時の 「最小化」か「最大化:元に戻す」あたりだと思いますが・・・。 (スクリーン座標とOfficeのピクセル座標の関係はかなり難しいので、メニューだけ表示させるとか最大化しておくとかしないとちょっとしたことでうまく動作させられなくなります。) プログラムは最初の部分以外を標準モジュールに書いてあるみたいなので無関係と思いますが Private Declare Sub mouse_event Lib ・・・・・ これだけprivate宣言してあるのは間違えやすいので他とそろえるようにしたほうがいいです。

007itochan
質問者

お礼

ありがとうございます。 座標軸は間違っていないと思います(で、座標軸取り込む部分も記載しました) 現状、マウスがとんだ状態で、クリックすれば予定通りですので、 で、ぶっちゃけ、いろいろなところからのコピペゆえ Private Declare Sub mouse_event Lib ・・・・・ これだけprivate宣言してあるのは・・・ どう直せばいいでしょ?? 恐縮ですが 置く場所を 間違ったかな?

関連するQ&A

  • VBAでのカーソル移動とマウスクリック

    業務上の単純作業の自動化のため、VBAから他のアプリケーションを操作することが目的です。 以前、ブラウザ上での作業の時に使用した、下記2つのAPIでは今回はマウスカーソルが指定した座標に動いてくれません、、、 Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal Y As Long) As Long Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) この2つのAPI以外で、カーソル移動とマウスクリックを実現する方法は何かありますでしょうか? 色々な方法を教えていただけるとVBAの勉強にもなり幸いです。 ' // 標準モジュール Option Explicit Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal Y As Long) As Long Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long) Private Type POINTAPI     x As Long     y As Long End Type Private Sub クリックテスト() Call SetCursorPos(216, 421) Sleep 400 Call mouse_event(&H2, 0, 0, 0, 0) Call mouse_event(&H4, 0, 0, 0, 0) End Sub

  • マウス関連のAPIについて

    マウスがどのフォーム(自分のフォームでないときも)でも左クリックしたときの状態の取得方法を教えてください。 Public Declare Function SetCursorPos& Lib "user32" (ByVal x As Integer, ByVal y As Integer) Public Declare Function GetCursorPos& Lib "user32" (ByRef lpPoint As POINTAPI) で、マウスの位置の取得設定はわかりました。

  • Excel VBA によるマウス操作

    こんばんは。 まず以下のコードをご覧ください。 Public Declare Sub mouse_event Lib "user32.dll" _ (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, _ ByVal dwData As Long, ByVal dwExtraInfo As Long) Public Const MOUSEEVENTF_ABSOLUTE = &H8000& Public Const MOUSEEVENTF_MOVE = &H1 Public Const MOUSEEVENTF_LEFTDOWN = &H2 Public Const MOUSEEVENTF_LEFTUP = &H4 Public Const MOUSEEVENTF_MIDDLEDOWN = &H20 Public Const MOUSEEVENTF_MIDDLEUP = &H40 Public Const MOUSEEVENTF_RIGHTUP = &H10 Public Const MOUSEEVENTF_RIGHTDOWN = &H8 Sub test() Call mouse_event(MOUSEEVENTF_ABSOLUTE, 10, 65500, 0, 0) Call mouse_event(MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0) Call mouse_event(MOUSEEVENTF_LEFTUP, 0, 0, 0, 0) End Sub ExcelでSub test()を実行し、マウスで画面の左下の「スタート」を左クリックしたのと同じ結果が出ればいいのですが、うまくいきません。 フォームボタンで実行したらしばらくポインターが点滅していました。 クリックはされているようですが、移動ができてないようです。 このAPI関数というものが、このカテゴリーでよいのかも分からない私ですが、どうかご回答よろしくお願いします。

  • VBAでSetTextColorがうまくいかない

    EXCELのVBAでユーザーフォームを使ったグラフィック表示のプログラムを 作っているのですが、SetTextColorでテキスト色の設定をしようと してもうまくいきません。何故か設定しようとする色の値が無視されて 「1304008」が設定されてしまいます。(GetTextColorで確認) そしてそれ以降何を設定してもこの状態のままです。 何か考えられることがありますでしょうか。 下にそのプログラムを示します。 ちなみにSetBKColorやAngleArcなど他のグラフィック命令は問題なく 動いていてSetTextColorだけがうまくいってない状態です。 '------------------------------------------------- ' ユーザーフォーム用プログラム '------------------------------------------------- Private Declare Function GetActiveWindow Lib "user32" () As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpszClass As String, _ ByVal lpszWindow As String) As Long Private Declare Function GetDC Lib "user32" ( _ ByVal hWnd As Long) As Long Private Declare Function ReleaseDC Lib "user32" ( _ ByVal hWnd As Long, _ ByVal hdc As Long) As Long Private Declare Function SetTextColor Lib "gdi32" _ (ByVal hdc As Long, crColor As Long) As Long Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" _ (ByVal hdc&, ByVal x&, _ ByVal y&, ByVal lpString$, ByVal nCount&) As Long Dim hWnd As Long Dim hdc As Long Public Sub UserForm_Activate() DoEvents hWnd = FindWindowEx(GetActiveWindow, 0, "F3 Server 60000000", "") hdc = GetDC(hWnd) ret = SetTextColor(hdc, RGB(255, 0, 0)) ret = TextOut(hdc, 0, 0, "abc", 3) Call ReleaseDC(hWnd, hdc) End Sub '-------------------------------------------------

  • VBAでIEの「ファイルのダウンロード」ダイアログを制御

    VBではなくVBAにて、IEの「ファイルのダウンロード」ダイアログを制御したいと思い、過去の同様の質問等を参考に下記のソースを作成して動かしてみましたが、「ファイルのダウンロード」画面で、「保存(S)」ボタンのハンドルを取得するところまではできましたが、sendMessageでクリックができず、次に進むことが出来ませんでした。 手動で「保存(S)」ボタンを押下して、強制的に「名前を付けて保存」画面に遷移させた後プログラムを再開すると、同画面の「保存(S)」ボタンのクリックはできました。 同じロジックで「名前を付けて保存」画面の「保存(S)」は動くのに、「ファイルのダウンロード」画面の「保存(S)」が動かないのはなぜでしょうか。 どなたかおわかりになる方がいらっしゃいましたら、ご回答をお願いします。 ***使用環境*** OS: XP pro IE: 6 OFFICE:2002 ***以下作成したソース(エラー制御は省略)*** Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetDlgCtrlID Lib "user32" (ByVal hwnd As Long) As Long Private Sub Test() Dim ret1 As Long Dim ret2 As Long Const WM_COMMAND As Long = &H111 ret1 = FindWindow("#32770", "ファイルのダウンロード") ret2 = FindWindowEx(ret1, 0, "Button", "保存(&S)") Call SendMessage(ret1, WM_COMMAND, GetDlgCtrlID(ret2), ByVal ret2) ret1 = FindWindow("#32770", "名前を付けて保存") ret2 = FindWindowEx(ret1, 0, "Button", "保存(&S)") Call SendMessage(ret1, WM_COMMAND, GetDlgCtrlID(ret2), ByVal ret2) End Sub ***以上ソース終わり***

  • WinAPIで電卓をクリック

    現在、WinAPIを勉強しており、練習としてVBAを用いて、電卓アプリのボタンをクリックしようとしています。 キーを送るのではなく、クリックで行いたいたいと 考えています。 ボタンのハンドルを取得するところまではできましたが、sendMessageでクリックできず、EditBoxに数字が 入りません。 どのようにすればよいのかご教授ください。 よろしくお願い致します。 環境: WinXP home、 Excel2002、Win付属アプリの電卓v5.1 ---作成したプログラム---- '標準モジュールの中身 Option Explicit Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function SetForegroundWindow Lib "user32.dll" (ByVal hWnd As Long) As Long Private Const WM_LBUTTONDOWN = &H201 Private Const WM_LBUTTONUP = &H202 Sub Main() Dim lngWindWnd As Long 'ウィンドウハンドル Dim ret As Long Dim hCalc As Long 'アプリケーションタイトルより、ウィンドウハンドルを得ます lngWindWnd = FindWindow(vbNullString, "電卓") '8ボタンのハンドル(確実に取れていることを確認 hCalc = FindWindowEx(lngWindWnd, 0, "Button", "8") ret = SetForegroundWindow(lngWindWnd) ret = SendMessage(hCalc, WM_LBUTTONDOWN, 0, 0) End Sub

  • 64ビットエクセルでのAPI宣言/PtrSafe

    エクセルのInputboxで、入力された文字列を自動的にアスタリスクで隠すようにする方法を探し http://okwave.jp/qa/q2371878.html の回答No1のコードがまさに最適なコードで、これまで非常に助かっていました。 ところが、64bitのエクセルでは動かないことがわかりました。 表示されたエラーメッセージの言葉から調べて、PtrSafeという言葉を入れなければならないようなのでAPI宣言を以下のようにしてみました。 #If VBA7 And Win64 Then '64ビット版 Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare PtrSafe 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 PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) As Long Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long #Else '32ビット版 Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) 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 SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) 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 GetCurrentThreadId Lib "kernel32" () As Long #End If ところが、回答No1のコードで Sub Report_Open() を実行すると Public Function InputBoxDK(Prompt, Optional Title, Optional Default, Optional XPos, _ Optional YPos, Optional HelpFile, Optional Context) As String のところがハイライトされてエラーになります。 どう直せば良いのでしょうか? 全文のコードを乗せると字数制限に引っかかりますので、申し訳ありませんが宣言以外の部分は http://okwave.jp/qa/q2371878.html の回答No1のコードを見てくださいますようお願いします。

  • VBAにおける Option Explicitの役割

    VBAにおける Option Explicitの役割 VBAでゲームを作ることを勉強している初心者です。 本に従ってもっとも基本的なスロットゲームをためしました。 プログラム本体の前にある下記のOption Explicitを省くとコンパイルエラーになります。 VBAにおける Option Explicitはプログラム本体中にあるどのキーがどのスロットを止めるなどの指示を 具体的記述なしに有効にするなどの役目があるのでしょうか。 Option Explicit Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Declare Function GetTickCount Lib "kernel32" () As Long 'Windows起動後経過時間取得API どなたか教えていただけると助かります。 よろしくお願いいたします。

  • Excel VBAでアプリのウィンドウ名取得

    WindowsXP, Excel2007で、ExcelからIE8にキーコードを送りたいです。 ネットで拾った以下のコードにより、 Option Explicit Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" _ (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long Public Declare Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Function activate_win(win_name As String) As Long Dim hwindow As Long hwindow = FindWindow(vbNullString, win_name) If hwindow <> 0 Then SetForegroundWindow hwindow activate_win = hwindow End Function Call activate_win("ウィンドウ名") Sendkeys "ABC", True のような形で、メモ帳での動作は確認したのですが、 IEだとウィンドウがアクティブになってくれません。 おそらくウィンドウタイトルを間違えているのだと思われますが、 全角半角などを変えてみたりしても、どう見比べてみても間違いがわかりません。 見た目ではわからない、似た文字だが違うということではないかと思っています。 そこで、開いているアプリのウィンドウ名すべてをメモ帳に書き出すような (あるいは任意のアプリにペーストできるようにするような)コードはないでしょうか? よろしくお願いします

  • Formを動かせるようにしたい

    お世話になります。 OS XP PRO  VB6(SP5)で開発しています。 ディスプレイのサイズによりFormを動かせたり固定させたりしたいのですが、 規定値は固定にしたいのでFormプロパティのMoveableはFalseにしてあります。 下記のようにプログラミングしたのですが固定されたままです。 Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function GetSystemMenu Lib "user32" (ByVal _ hwnd As Long _ , ByVal bRevert As Long) As Long Private Declare Function RemoveMenu Lib "user32" ( _ ByVal hMenu As Long, ByVal nPosition As Long, _ ByVal wFlags As Long) As Long Private Declare Function DrawMenuBar Lib "user32" ( _ ByVal hwnd As Long) As Long Private Const MF_BYCOMMAND = &H0 Private Const SC_MOVE = &HF010 Private Sub Form_Load() Dim kk As Long kk = GetSystemMenu(.hwnd, bb) Call RemoveMenu(kk, SC_MOVE, MF_BYCOMMAND) Call DrawMenuBar(.hwnd) End Sub アドバイス頂きたくよろしくお願いします。 以上です。