• ベストアンサー

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

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

  • ベストアンサー
  • taka_tetsu
  • ベストアンサー率65% (1020/1553)
回答No.6

>ret = SendMessage(hCalc, WM_LBUTTONDOWN, 0, 0) >ret = SendMessage(hCalc, WM_LBUTTONUP, 0, 0) > >の順に送ってみましたが,電卓ウィンドウが前面に出>てくるだけで,EditBoxに変化が起きませんでした。 まず、PostMessageにしましょう。 しなくても動くかもしれませんが、するべきです。 で、第3引数には、左ボタンをあらわすMK_LBUTTON、 第4引数は、ByVal 0とする必要があります。 #Declareステートメントで、As Anyと宣言しているため。 Win32api.txtのPostMessageの宣言をそのまま使うんだったら、ByVal lParam As Longなので、そのまま0でかまいません。 Const MK_LBUTTON = &H1 ret = PostMessage(hCalc, WM_LBUTTONDOWN, MK_LBUTTON, ByVal 0) ret = PostMessage(hCalc, WM_LBUTTONUP, MK_LBUTTON, ByVal 0)

0shiete
質問者

お礼

ご回答有難うございます。 この#6で教えていただいたとおり やってみたら、できました。 有難うございます。 自分の勉強のためにも、 他の回答もじっくり読ませていただいてから 質問を締め切ろうと思っています。 ご了承ください。

その他の回答 (10)

  • TAGOSAKU7
  • ベストアンサー率65% (276/422)
回答No.11

っていうかよく読むと、、、 「VBA」 でしたね。。。今気づきました。。。 下の長文サンプル無視で、GetDlgCtrlIDを使用するってことだけ読み取ってください。 (taka_tetsuさん。またよろしくです。) (とーどーあにぃも、またよろしくです。) また忙しくなるのでロムる予感。

0shiete
質問者

お礼

ご回答有難うございます。 >下の長文サンプル無視で、GetDlgCtrlIDを使用するってことだけ読み取ってください。 VBAでコントロール配列を実現しなきゃいけないと 思ってました(^^; GetDlgCtrlIDを使用するとよいのですね。 了解しました。

  • taka_tetsu
  • ベストアンサー率65% (1020/1553)
回答No.10

wParamの上位と下位、逆でしたね(^^;;

  • TAGOSAKU7
  • ベストアンサー率65% (276/422)
回答No.9

>WM_COMMANDにしてるのはコマンドボタンです。 >VBがやってるわけではありません。 言葉が足りなかったようですね^^; 私はこの説明を受けたとき、VB製のコントロールを含め、VBと捉えております。 それと、補足ありがとうございます。 以前の書き込みの時は、VB製のアプリ同士の連携しかしたことがなかったので、スキル不足でした。^^; それとコントロールIDは下位の方だと思うのですが・・・ いかがでしょう?

  • taka_tetsu
  • ベストアンサー率65% (1020/1553)
回答No.8

>「VBがWM_LBUTTONDOWNとWM_LBUTTONUPを認識して、内部でWM_COMMANDを発行してCLICKイベントが発生するので、WM_COMMANDでクリックを直接呼べばよい」 WM_COMMANDにしてるのはコマンドボタンです。 VBがやってるわけではありません。 >VBはコントロールIDで管理していないので、コントロールIDが常に「0」です。 >んでもって定数:BN_CLICKEDは「0」です。 今回は電卓がターゲットなので、VBアプリではありません。コントロールIDは持っているはずです。 #XPで8のボタンは&H84でした。 なので、 >SendMessageの行を >Call SendMessage(lngWindWnd, WM_COMMAND, BN_CLICKED, ByVal hCalc) ということなんで、wParamの指定の仕方が違いますね。 コントロールIDをGetDlgCtrlIDで取得して、上位16ビットにセットする必要があります。 Call SendMessage(lngWindWnd, WM_COMMAND, BN_CLICKED + GetDlgCtrlID(lngWindWnd) * &H10000, ByVal hCalc) ですね。 >WM_COMMANDはボタンクリックのロジックを、直でたたき呼びます。 ということがおわかりでしたら、親ウィンドウでの処理の振り分けに何を使っているかがTAGOSAKU7さんなら想像つきますよね。 コントロールIDとウィンドウハンドルしかどのボタンから来たメッセージか判断する方法がないんですから。

  • TAGOSAKU7
  • ベストアンサー率65% (276/422)
回答No.7

PostMessage SendMessage について触れられているので、ついでに発言。。。 WM_LBUTTONDOWN WM_LBUTTONUP の順で送るなら、確かにPostMessageかと思います。 「マウスで押したことにする」という命令だから、その他のグラフィカルな部分にも影響するだろうし。。。 WM_COMMANDで送るならどちらでもよいかと。。。 私の場合は、割り込みをさせないためにWM_COMMANDの時はSendMessageを多用しております。 WM_COMMANDはボタンクリックのロジックを、直でたたき呼びます。 Spy++で見ると一目瞭然です。 それと今回は電卓なので、どちらでもよいかと思うのですが。。。 勝手にtaka_tetsuさんの発言に対しての補足させていただきます。。。 (決して悪意はありません。私の質問にあたなは答えてくれたことがあります。) 私も以前、マウスダウンとマウスアップで、他のアプリケーションを制御しようとしていました。 しかしVBでコマンドボタンのある画面を作り、そのコマンドボタンをtaka_tetsuさんと同様の方式を取ったところ、2回に1回だけ成功するというような状況に陥りました。 個人で登録しているメーリングリストに状況を質問をすると、 「VBがWM_LBUTTONDOWNとWM_LBUTTONUPを認識して、内部でWM_COMMANDを発行してCLICKイベントが発生するので、WM_COMMANDでクリックを直接呼べばよい」 とのレスを戴きました。

  • TAGOSAKU7
  • ベストアンサー率65% (276/422)
回答No.5

えーとですね。。。 VCとかで画面を作ったらわかるのですが、コントロール一つ一つにコントロールIDというのがあります。 VBはコントロールIDで管理していないので、コントロールIDが常に「0」です。 んでもって定数:BN_CLICKEDは「0」です。 本当はコントロールIDをSnedMessageの第3引数に渡します。 SendDlgItemMessage関数を利用する手もあります。(内部ではSendMessageで同じことをしています。) でわ ※構成 Project1  └Form1   └Command1 ← 「Index = 0」にして、コントロール配列にしてください   ※以下サンプル Option Explicit Private plngCalWnd As Long Private Const DEF_CALC_CAP As String = "電卓" Private Const WM_COMMAND As Long = &H111 Private Const BN_CLICKED As Long = &H0& Private Type RECT   Left  As Long   Top   As Long   Right  As Long   Bottom As Long End Type Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As Any, ByVal cch As Long) As Long Private Declare Function GetDlgCtrlID Lib "user32" (ByVal hwnd As Long) As Long Private Declare Function MoveWindow Lib "user32" (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 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 Sub Command1_Click(Index As Integer)   Dim varWk    As Variant   Dim lngBtnWnd  As Long   Dim lngDlgCtlID As Long      varWk = Split(Command1(Index).Tag, vbTab)   lngBtnWnd = varWk(0)   lngDlgCtlID = varWk(1)   Call SendMessage(plngCalWnd, WM_COMMAND, lngDlgCtlID, lngBtnWnd) End Sub Private Sub Form_Load()   '電卓取得   If Not GetCalc(plngCalWnd) Then     MsgBox "電卓起動失敗"     End   End If      '画面初期設定   Call InitForm      '電卓前面   Call AppActivate(DEF_CALC_CAP) End Sub '画面初期設定 Private Sub InitForm()   Dim rectCalc  As RECT   Dim lngWnd   As Long      '基本のボタンを見せない   Me.Command1(0).Visible = False      '電卓のサイズを取得   Call GetWindowRect(plngCalWnd, rectCalc)      '自分自身を電卓と同じサイズに変更   With rectCalc     Call MoveWindow(Me.hwnd, 0, 0, (.Right - .Left), (.Bottom - .Top), 1)          Do       'ボタンハンドルを取得       lngWnd = FindWindowEx(plngCalWnd, lngWnd, "Button", vbNullString)       '取得できないなら抜ける       If (lngWnd = 0) Then         Exit Do       End If              '電卓と同じボタンを作成       Call CreSameBtn(lngWnd, .Left, .Top + 23)     Loop   End With End Sub '指定ハンドルと同じキャプションのボタンを作成 Private Sub CreSameBtn(ByVal inBtnWnd As Long, ByVal inVectH As Long, ByVal inVectV As Long)   Const DEF_BUF_SIZE As Long = &HFF      Dim rectBtn   As RECT   Dim lngBtnIndex As Long   Dim btnWk    As CommandButton      Dim lngDlgCtlID As Long      Dim lngLen   As Long   Dim strCap   As String   Dim bytBuf(DEF_BUF_SIZE - 1) As Byte      '新たなコマンドボタンを作成   lngBtnIndex = Command1.UBound + 1   Load Command1(lngBtnIndex)   Set btnWk = Command1(lngBtnIndex)   btnWk.Visible = True   btnWk.TabStop = False      'コントロールIDを取得   lngDlgCtlID = GetDlgCtrlID(inBtnWnd)      'ハンドルとコントロールIDをボタンのタグに保存   btnWk.Tag = inBtnWnd & vbTab & lngDlgCtlID      'ボタンのキャプションを取得   lngLen = GetWindowText(inBtnWnd, ByVal VarPtr(bytBuf(0)), DEF_BUF_SIZE)   strCap = LeftByte(StrConv(bytBuf, vbUnicode), lngLen)   btnWk.Caption = strCap      'ボタンのサイズを取得   Call GetWindowRect(inBtnWnd, rectBtn)   With rectBtn     Call MoveWindow(btnWk.hwnd, (.Left - inVectH), (.Top - inVectV), (.Right - .Left), (.Bottom - .Top), 1)   End With End Sub '電卓取得 Private Function GetCalc(Optional otCalcWnd As Long) As Boolean   On Error Resume Next   otCalcWnd = FindWindow(vbNullString, DEF_CALC_CAP)   If otCalcWnd = 0 Then     Call Shell("Calc.exe")     otCalcWnd = FindWindow(vbNullString, DEF_CALC_CAP)   End If   GetCalc = (otCalcWnd <> 0&) End Function 'LEFT for バイト長 Private Function LeftByte(inValue, ByVal inStart As Long) As String   LeftByte = StrConv(LeftB$(StrConv(inValue, vbFromUnicode), inStart), vbUnicode) End Function

  • TAGOSAKU7
  • ベストアンサー率65% (276/422)
回答No.4

#3 でできます。

0shiete
質問者

補足

早速のご回答ありがとうございます。 また、返信が遅れて申し訳ありません。 #3の方の補足に書かせていただいたのですが、 電卓ウィンドウが前面に出てくるところまでは よいのですが、EditBoxに変化が起きません。 また、ご教授頂ければ幸いです。

  • todo36
  • ベストアンサー率58% (728/1234)
回答No.3

BN_CLICKEDで出来るかも。

参考URL:
http://oshiete1.goo.ne.jp/kotaeru.php3?q=199357
0shiete
質問者

補足

早速のご回答ありがとうございます。 また、返信が遅れて申し訳ありません。 教えていただいた参考URLを参考にやってみましたが、 電卓ウィンドウは前面にでてくるのですが、EditBox は「0」のままで「8」が入ってくれません。 また、ご教授頂ければ幸いです。 ---変更した点--- Private Const WM_COMMAND = &H111 Private Const BN_CLICKED = &H0& を追加し、 SendMessageの行を Call SendMessage(lngWindWnd, WM_COMMAND, BN_CLICKED, ByVal hCalc) に変更しました。

  • taka_tetsu
  • ベストアンサー率65% (1020/1553)
回答No.2

まず、マウスメッセージはPostMessageで送りましょう。 次に、WM_LBUTTONDOWNのあとに、WM_LBUTTONUPを送る必要があります。

  • gatyan
  • ベストアンサー率41% (160/385)
回答No.1

マウスのボタンを押して離した時点でクリックと認識されるのでは? DOWN , UP の順でメッセージを送ってみました?

0shiete
質問者

補足

早速のご回答ありがとうございます。 ret = SendMessage(hCalc, WM_LBUTTONDOWN, 0, 0) ret = SendMessage(hCalc, WM_LBUTTONUP, 0, 0) の順に送ってみましたが,電卓ウィンドウが前面に出てくるだけで,EditBoxに変化が起きませんでした。 また、ご教授いただければ幸いです。

関連するQ&A

  • 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 ***以上ソース終わり***

  • 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 '-------------------------------------------------

  • ExcelVBAで他のアプリをスクロールさせたい

    エクセルVBAから 他のアプリのスクロールバーを操作して、指定範囲で画面スクロールしたいと思っています。 キー入力では操作出来ない(マウス操作でのみスクロールされる)アプリなので、 Sendkeysは使えないのではないかと思い、 APIでハンドルを取得して、 SendMessageすればできるかなと思いましたが、APIについてよく分からないので、 とりあえず、メモ帳で以下を作成してみました。しかし、スクロールされません。 どこがいけないのか教えていただけないでしょうか? よろしくお願いします。 *************** Public Declare Function FindWindowA Lib "User32" (ByVal cnm As String, ByVal cap As String) As Long Public Declare Function SendMessage Lib "User32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long Public Const WM_VSCROLL = &H115 Public Const WM_HSCROLL = &H114 Public Const SB_TOP = &H6& Public Const SB_BOTTOM = &H7& Sub handle_get()  Dim Handle As Long  Dim Ap1 As String  Ap1 = "a.txt - メモ帳"  AppActivate Ap1  Handle = FindWindowA(vbNullString, Ap1)  SendMessage Handle, WM_VSCROLL, SB_BOTTOM, ByVal CLng(0)  SendMessage Handle, WM_HSCROLL, SB_TOP, ByVal CLng(0) End Sub ***************

  • EXCELVBA フォルダ検索API

    エクセルからVBAでフォルダを選択させるコマンドを、APIを使ってフォルダ検索ダイアログボックスを出すまでは見よう見真似でできるのですが、このとき「あたらしいフォルダ」のボタンは必要ないので出したくないのですが、どこかに定数を指定すればよろしいかご存知でしたら教えてください。 (使用OS: Windows2000,Excel:2003) ちなみにコピペした宣言部分は以下のものです。 *************** Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, ByVal pszPath As String) As Long Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" _ (lpBrowseInfo As BROWSEINFO) As Long Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal wMsg As Long, _ ByVal wParam As Long, lParam As Any) As Long Public Const WM_USER = &H400 Public Const BFFM_SETSELECTIONA = (WM_USER + 102) Public Const BFFM_INITIALIZED = 1 ********************

  • windows7のエクスプローラをVBAで操作-1

    アドバイスをお願いします。 Excel-VBAで起動しているエクスプローラに対してハンドルを取得してクリックしたり、テキストボックスに文字をセットするプログラムを作って動かしています。 WindowsXPのときはできていたのですが、Windows7になったら正しく動作しなくなりました。 下のコードはエクスプローラの現在のフォルダパスが表示されるところに(添付ファイル参照)文字を入れるものです。 最後のSendMessageAnyで1が返ってしまいます。何が考えられますでしょうか。どう対策したらいいでしょうか。 なおハンドルの値はSDKのInspect Objectsで確認していますので、正しく取得できていると思っています。 よろしくお願いします。 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Declare Function SendMessageAny Lib "user32.dll" _ Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal MSG As Long, _ ByVal wParam As Long, _ ByVal lParam As Any) As Long Const WM_SETTEXT = &HC Private hwnd As Long Private FOLDER As String Sub Put_folder_name1() hwnd = FindWindow("CabinetWClass", vbNullString) hwnd = FindWindowEx(hwnd, 0, "WorkerW", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ReBarWindow32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Address Band Root", vbNullString) hwnd = FindWindowEx(hwnd, 0, "msctls_progress32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ComboBoxEx32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ComboBox", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Edit", vbNullString) FOLDER = "\\xx.xx.xx.xx\test" RC = SendMessageAny(hwnd, WM_SETTEXT, 0, ByVal FOLDER) 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のコードを見てくださいますようお願いします。

  • windows7のエクスプローラをVBAで操作-2

    アドバイスをお願いします。 Excel-VBAで起動しているエクスプローラに対してハンドルを取得してクリックしたり、テキストボックスに文字をセットするプログラムを作って動かしています。 WindowsXPのときはできていたのですが、Windows7になったら正しく動作しなくなりました。 下のコードはエクスプローラのフォルダパスの右のボタン(添付ファイル参照)をクリックすべく、コーディングしたものです。 最後のSendMessage(hwnd, BM_CLICK, 0, 0) でクリックしたいのですが、その前にボタンのハンドルが取得できません。SDKのInspect Objectsで調べると、このボタンはClass="ToolbarWindow32"でName="前の場所"ですが、NativeWindowHandleが表示されず、Legacy.IAccessible.ChildID=1となっています。 このようなウィンドゥは別のやり方(IAccessible?)でないとクリックできないように感じていますが如何せん知識がありません。 どうしたらできるか、アドバイスよろしくお願いします。 Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As Any, ByVal lpWindowName As Any) As Long Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" ( _ ByVal hwndParent As Long, _ ByVal hwndChildAfter As Long, _ ByVal lpClassName As String, _ ByVal lpWindowName As String) As Long Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, ByVal MSG As Long, ByVal wParam As Long, lParam As Any) As Long Const BM_CLICK = &HF5 Private hwnd As Long Sub Click_button() hwnd = FindWindow("CabinetWClass", vbNullString) hwnd = FindWindowEx(hwnd, 0, "WorkerW", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ReBarWindow32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "Address Band Root", vbNullString) hwnd = FindWindowEx(hwnd, 0, "msctls_progress32", vbNullString) hwnd = FindWindowEx(hwnd, 0, "ToolbarWindow32", vbNullString) ' この次が分からない。 RC = SendMessage(hwnd, BM_CLICK, 0, 0) end sub

  • APIを使う時は参照設定は不要?

    例えば Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Sub test() Dim Handle As Long Handle = FindWindow("IEFrame", vbNullString) Debug.Print Handle End Sub と言うコードでウィンドウハンドルを取得する場合、 参照設定のどこにもチェックを入れませんが、なぜ参照設定しなくても使えるのでしょうか? Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long が参照設定の代わりになるのですか?

  • ExcelVBAでフォームのタイトルバーで右クリックした場合などに閉じるボタンが有効化されないようにするコード

    Excelのプログラムで、最小化ボタンを有効にし、閉じるボタンを無効にする質問をしたんですが、うまくいったと思ったのですがフォームが開き、タイトルバーで右クリックした場合などは閉じるボタンが有効化されてしまうのでこれを無効のままにするコードを教えてください。 作ったプログラムは以下の通りです。 標準モジュール Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function DrawMenuBar Lib "user32" _ (ByVal hWnd As Long) As Long Public Declare Function GetSystemMenu Lib "user32.dll" _ (ByVal hWnd As Long, ByVal bRevert As Long) As Long Public Declare Function EnableMenuItem Lib "user32" _ (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long Public Const MF_DISABLED = &H2& Public Const GWL_STYLE = (-16) Public Const WS_MINIMIZEBOX = &H20000 Public Const MF_BYCOMMAND = &H0& Public Const SC_CLOSE = &HF060& Dim hSysMenu As Long UserForm_Initializeプロシージャ Dim fRet As Long Dim hWnd As Long Dim fStyle As Long hWnd = FindWindow("ThunderDFrame", "UserForm1") fStyle = GetWindowLong(hWnd, GWL_STYLE) fStyle = (fStyle Or WS_THICKFRAME Or WS_MINIMIZEBOX) fRet = SetWindowLong(hWnd, GWL_STYLE, fStyle) hSysMenu = GetSystemMenu(hWnd, 0) EnableMenuItem hSysMenu, SC_CLOSE, MF_BYCOMMAND Or MF_DISABLED fRet = DrawMenuBar(hWnd) 回答よろしくお願いします。

  • 「&HFFFF」「&H1A」とは?

    はじめまして。 vb6.0の開発をしている者です。 表題にもありますように、「&HFFFF」「&H1A」は何を指しているのでしょうか? 実際は以下のように記述しています。 l = SendMessage("&HFFFF", "&H1A", 0, "windows") Declare Function SendMessage Lib "user32" Alias "SendMessageA" _ (ByVal hwnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lparam As String) As Long 初歩的な質問で申し訳ないのですが、なかなかこれだ!という情報を見つけれずにいます。よろしくお願いします。

専門家に質問してみよう