Excel2002のVBAで押されているキーの評価について
- Excel2002のVBAでキーを判別するコードで、Altキーが離された後でも1度だけ押されていると評価されてしまう問題が発生しています。
- この問題は回避する方法はあるのでしょうか?
- GetAsyncKeyState関数を使用してAltキーの押下状態を判別しているVBAコードで、キーが離された後でも1度だけ押されていると評価されてしまう問題が発生しています。回避する方法はあるのでしょうか?
- ベストアンサー
押されているキーの評価について
Excel2002のVBAです。 次のコードで押されたキーを判別していますが、Altの時だけ、 キーを離なしても、離したあと1度だけ、押されていると評価 されてしまいます。 これは回避できないのでしょうか? '--------------------------- Declare Function GetAsyncKeyState Lib "user32.dll" _ (ByVal vKey As Long) As Long '--------------------------- Private Sub CommandButton1_Click() If GetAsyncKeyState(vbKeyControl) <> 0 Then MsgBox "CTRLキーを押しながらクリックされました。" End If If GetAsyncKeyState(vbKeyShift) <> 0 Then MsgBox "Shiftキーを押しながらクリックされました。" End If If GetAsyncKeyState(vbKeyMenu) <> 0 Then MsgBox "Altキーを押しながらクリックされました。" End If End Sub
- urourojp
- お礼率34% (34/100)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 （1）
- 専門家の回答
質問者が選んだベストアンサー
こちらが参考になりそうです。 http://www.mb.ccnw.ne.jp/garger-studio/vbgame/142.html
関連するQ&A
- エクセルVBA セルの入力後「Delete」キーを押したか判断するプログラム
セルに入力したあとその入力したキーが「Delete」キーかどうか判定するプログラムを作りたいのですが、下記のようにコードを書きました。 '標準モジュール Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long 'Microsoft Excel Objects（ワークシート） Private Sub Worksheet_Change(ByVal Target As Range) If GetAsyncKeyState(46) <> 0 Then 'キーボードの「Delete」キーかどうか判定 ○○ Else ○○ End If End Sub ところが、「Delete」キーを押してもGetAsyncKeyState(46)の値が「0」になり、「Delete」キーを押してないことになってしまいます。どのようにすればよいのでしょうか？ 回答よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
- VBAでGetAsynckeyStatekのエラー
初めて質問します。なので、情報が少なかったらすみません。 windows7 64bit Excel2010でVBAにトライしています。 その中で「GetAsynckeyState」関数を使用して、キーボードの入力を判定したく、 コードを書いたところ「GetAsynckeyStateはUser32.dll 内に見つかりません」という エラーが発生しました。 下記がそのコードです。使用できるようにしたいのですがどうしたらいいでしょうか。ご教授お願いします =================== Option Explicit Private Declare Function GetAsynckeyState Lib "user32.dll" (ByVal vKey As Long) As Long Sub test() If GetAsynckeyState(38) <> 0 Then Range("B1") = "●" Else Range("B1") = "" End If End Sub ====================
- ベストアンサー
- オフィス系ソフト
- GetCursorInfoの使い方
GetCursorInfoの使い方について教えてください。現在は下記のようにしていますが返り値に0しかはいりません。なにがおかしいかご指導お願いします。m(._.)m ペコッ --モジュール-- Public Declare Function GetCursorInfo Lib "user32" (pci As CURSORINFO) As Long Public Declare Function GetAsyncKeyState Lib "user32.dll" (ByVal vKey As Long) As Integer Public Type POINTAPI X As Long Y As Long End Type Public Type CURSORINFO cbSize As Long flags As Long hCursor As Long ptScreenPos As POINTAPI End Type Public Field As CURSORINFO --Form1-- Dim lRet As Long Private Sub Timer1_Timer() If GetAsyncKeyState(vbKeyHome) Then lRet = GetCursorInfo(Field) End If End Sub
- ベストアンサー
- Visual Basic
- ExcelVBAで、キーボード方向キーを押したら、その方向に塗りつぶし
ExcelVBAで、キーボード方向キーを押したら、その方向に塗りつぶしたセルを移動させたいです。 とりあえず、以下のようなマクロを組んだのですが、 方向キーを一度でも押すと、押した方向の彼方へ一瞬で飛んでいってしまいます。 Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long 'キー入力のAPI '一番最初に塗りつぶすセル set 塗りつぶし = Range("B2,C2") do 塗りつぶし.Interior.ColorIndex = 3 '赤く塗りつぶし '左入力したら塗りつぶしセルを左に移動 If GetAsyncKeyState(37) Then 塗りつぶし.Interior.ColorIndex = 0 Set 塗りつぶし = 塗りつぶし.Offset(0, -1) End If '右入力したら塗りつぶしセルを右に移動 If GetAsyncKeyState(39) <> 0 Then 塗りつぶし.Interior.ColorIndex = 0 Set 塗りつぶし = 塗りつぶし.Offset(0, 1) End If Loop 予想なんですが、一度でもキーを入力したら、 その方向へずっと入力しているようになっている と思うのですが、どう直して良いか分かりません。 宜しくお願いします。
- ベストアンサー
- その他MS Office製品
- Do Loop Until 条件停止後のセル位置について
こんにちは。いつもお世話になります。 ただ今、シート上の緑色のセルをカーソルで移動させるプログラムを 作っています。 停止の条件は[SHIFT]キーを押すと止まります。 一応は停止しますがセルの位置がズレてしまい、なんとか現在選択 している位置で停止できないものかと思い、アドバイス願います。 コードは下記になります。 Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vkey As Long) As Long Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long) Sub Key_Sample() Cells(1, 1).Select On Error Resume Next '繰返し開始 Do '上方向のキー入力判定 If GetAsyncKeyState(38) <> 0 Then Selection.Interior.ColorIndex = xlNone ActiveCell.Offset(-1, 0).Select Selection.Interior.ColorIndex = 4 Else Selection.Interior.ColorIndex = 4 End If '下方向のキー入力判定 If GetAsyncKeyState(40) <> 0 Then Selection.Interior.ColorIndex = xlNone ActiveCell.Offset(1, 0).Select Selection.Interior.ColorIndex = 4 Else Selection.Interior.ColorIndex = 4 End If '左方向のキー入力判定 If GetAsyncKeyState(37) <> 0 Then Selection.Interior.ColorIndex = xlNone ActiveCell.Offset(0, -1).Select Selection.Interior.ColorIndex = 4 Else Selection.Interior.ColorIndex = 4 End If '右方向のキー入力判定 If GetAsyncKeyState(39) <> 0 Then Selection.Interior.ColorIndex = xlNone ActiveCell.Offset(0, 1).Select Selection.Interior.ColorIndex = 4 Else Selection.Interior.ColorIndex = 4 ActiveCell.Select End If Sleep 100 Loop Until GetAsyncKeyState(16) <> 0 End Sub
- 締切済み
- Visual Basic
- VBAのキー入力待ちでCPU負荷大
VBAでキー入力待ちで動作をするプログラムを組んでいますが、 プログラムの組み方が悪くCPUの負荷が高くなり、CPUの温度が かなり上がってしまいます。 いろいろ調べたのですがわかりません。 負荷を下げるプログラムの書き方を教えていただけないでしょうか。 Excel2010です。 よろしくお願いします。 Sub ボタン1_Click() Dim i, j, k, Maxrow, Colst, colen, nCnt As Integer Do Until GetAsyncKeyState(27) If GetAsyncKeyState(75) <> 0 Then ・ ・ 「モジュールプログラム1」 ・ ・ Do Until GetAsyncKeyState(75) = 0 Loop ElseIf GetAsyncKeyState(77) <> 0 Then ・ ・ 「モジュールプログラム2」 ・ ・ Do Until GetAsyncKeyState(77) = 0 Loop ElseIf GetAsyncKeyState(37) <> 0 Then If ActiveCell.Column > 1 Then ActiveCell.Offset(0, -1).Activate End If ElseIf GetAsyncKeyState(38) <> 0 Then If ActiveCell.Row > 1 Then ActiveCell.Offset(-1, 0).Activate End If ElseIf GetAsyncKeyState(39) <> 0 Then ActiveCell.Offset(0, 1).Activate ElseIf GetAsyncKeyState(40) <> 0 Then ActiveCell.Offset(1, 0).Activate End If For k = 1 To 300: Next k Loop Sheets("Main").Activate End Sub
- ベストアンサー
- Visual Basic
- VBAで画像ファイルをダウンロードしたいけどうまく
VBAで画像ファイルをダウンロードしたいけどうまく行かない・・・ XPで、オフィス２００３です。 http://officetanaka.net/other/extra/tips01.htm を参考に、画像ファイルをダウンロードする練習をしているのですが "エラーが発生しました"になってしまいます。 標準モジュールに --------------------------------------------------------- Option Explicit Public Declare Function URLDownloadToFile Lib "urlmon" _ Alias "URLDownloadToFileA" (ByVal pCaller As Long, _ ByVal szURL As String, ByVal szFileName As String, _ ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long Sub Sample() GetImageFile "http://www.officetanaka.net/sample.jpg", "C:\sample.jpg" End Sub Sub GetImageFile(ImgName As String, SaveName As String) Dim SaveFileName As String, DownloadFile As String, Ret As Long Ret = URLDownloadToFile(0, DownloadFile, SaveFileName, 0, 0) If ImgName = "" Then Exit Sub SaveFileName = SaveName DownloadFile = ImgName Ret = URLDownloadToFile(0, DownloadFile, SaveFileName, 0, 0) If Ret = 0 Then MsgBox "ダウンロードできました" Else MsgBox "エラーが発生しました" End If End Sub --------------------------------------------------------- を貼り付けました。 Retが0にならなくてはいけないみたいですが、 自分の場合は、-2147221020になってしまいます。 どう修正すればいいのか教えてください。
- ベストアンサー
- オフィス系ソフト
- Excel VBA 一定の数値以下で音を鳴らす
一つのセル内の数値（VBAにより、1秒ごとに更新される流動的な数値です）において、-2以下になるとすぐにBEEＰ音が鳴る設定をしたいのですが、何故か１分ごとにしか鳴りません。 今のモジュールは、標準モジュールに Public Declare Function Beep Lib "kernel32" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long Sheet1に Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 Then If Range("Q6") < -2 Then Call Beep(2000, 500) Call Beep(2000, 500) End If End If End Sub と入力しています。 改善方法をどうかご教授願います。
- ベストアンサー
- オフィス系ソフト
- アクセスでテキストを開く
アクセスでパスを指定して、特定のテキストファイルを開く方法を教えていただけますか？ いかのモジュールを見つけたのですが、どこに、動かないか… フルパスを入れればよいか分かりません。 どうぞ宜しくお願いします。 *********************************************************************************************** Private Declare Function ShellExecute Lib "SHELL32.DLL" Alias "ShellExecuteA" (ByVal hwnd As Long, _ ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, _ ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Private Sub コマンド0_Click() Dim strFilePath As String Dim lngRet As Long Const SW_SHOWNORMAL = 1 strFilePath = Me.txt_Path 'WinAPIを使って関連付けられたアプリケーションを起動 lngRet = ShellExecute(Application.hWndAccessApp, "OPEN", _ strFilePath, vbNullString, CurDir(), SW_SHOWNORMAL) If lngRet <= 32 Then '返り値が 32 以下の場合はエラー MsgBox "ファイルを開けません！", vbOKOnly + vbExclamation End If End Sub ***********************************************************************************************
- ベストアンサー
- その他MS Office製品
- エクセルでゲームパッド対応させるには？
今エクセルでゲームを作っていて、ゲームパッドで（十字キー）上下左右に反応させたいのですが、どうマクロを組んだらいいのかわからないのでできればおしえてください。お願いします ボタンについてもおしえ（ｒｙ← If JS(JoyID).dwXpos = 0 Then ←は動いた If JS(JoyID).dwYpos = 0 Then ←は動かない ??????? Declare Function joyGetPos Lib "winmm.dll" (ByVal ujoyID As Long, pji As _ JOYINFO) As Long Type JOYINFO dwXpos As Integer dwYpos As Integer dwButtons As Integer End Type Dim JS(255) As JOYINFO Sub a() joyGetPos JoyID, JS(JoyID) If JS(JoyID).dwXpos = -1 Then ’キャラクタ移動 ＜省略＞ End If DoEvents End Sub
- ベストアンサー
- オフィス系ソフト
お礼
ありがとうございました。 また、よろしくお願いします。