質問

ExcelのVBAで3択クイズを作っていて、ユーザーフォーム上で解答選択支が表示されている
コマンドボタンが3つあって、
そのどれかをクリックすると正解か不正解の表示が出る仕組みのプログラムを作ったのですが、
スムーズに選択できるようキーボードでコマンドボタンを押せるようにしたいのです。

左キーを押すとコマンドボタン1、上キーを押すとコマンドボタン2、右キーを押すとコマンドボタン3
が反応するといった感じにしたいのです。

いろんなサイトを見て回ったのですがAPIのGetAsyncKeyStateという関数を使うというところまでは
分かったのですが素人なものでそこから先を何を記述すべきか分からなくて困っています。
いろいろためしたものの反応がしなくて分からないです。
なにかいい方法はありませんか?

通報する

回答 (5件)

#2です。
xl2000とxl2010で確認しております。他のバージョンは分かりませんが別の理由だと思います。
然るべきモジュールに置かれたのか、他のルーチンと同居させたのか等が分かりませんのでお返事のしようはないですが、GetAsyncKeyStateの使い方の一例を紹介させていただいたのみですので、スルーして下さって結構です。

再掲:
>他のコントロールを置かなきゃならないなら,そちらのコントロールもフォーカスを持たないようにするか,またはフォーカスを持つ(可能性のある)コントロールのkeyDownイベントに同じ仕込みをしておくこと


意味が分からなくてスルーしてたのなら,そこを聞くべきだったのではありませんか?
次の通り追加します

Private Sub CommandButton1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 If KeyCode = 39 Then CommandButton1_Click
 If KeyCode = 38 Then CommandButton2_Click
 If KeyCode = 37 Then CommandButton3_Click
End Sub

Private Sub CommandButton2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 If KeyCode = 39 Then CommandButton1_Click
 If KeyCode = 38 Then CommandButton2_Click
 If KeyCode = 37 Then CommandButton3_Click
End Sub

Private Sub CommandButton3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 If KeyCode = 39 Then CommandButton1_Click
 If KeyCode = 38 Then CommandButton2_Click
 If KeyCode = 37 Then CommandButton3_Click
End Sub

Private Sub CommandButton4_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 If KeyCode = 39 Then CommandButton1_Click
 If KeyCode = 38 Then CommandButton2_Click
 If KeyCode = 37 Then CommandButton3_Click
End Sub

この回答へのお礼

回答ありがとうございました。
無事に理想どうりに動きました。

1問目とか2問目と言われても,ナンのことか(アナタのエクセルがどうなっているのか)さっぱり判りません。
具体的なハウツーの回答が必要でしたら,もっとエクセルの(ユーザーフォームの)姿をキチンと情報提供するよう頑張って説明してみてください。



断片的な情報から推測できることとしては恐らく
>黒枠が動くだけ

回答で説明した
・他のコントロールがない
という条件が満たされていない,

若しくは
・プロパティパネルで設定する
という準備を怠っている

と考えられます。


もしご自分で作成した(作成中の)モノの説明ができないようでしたら,次のように作成すれば回答1で出来ますので作り直してください。
1.設問ごとにユーザーフォームを作成する
2.ユーザーフォームごとにコマンドボタン1,2,3を配置する
3.ユーザーフォームごとに各ボタンのプロパティを正しく設定する
4.ユーザーフォームごとにマクロを登録する

この回答への補足

英単語の3択でsheets1はコマンドボタンが1つあって、それを押すと全20問で問題がランダムに
出るユーザーフォームが出てくる仕組みです。
sheets2は問題の属性データと問題元データがあります。
問題元データはsheets1のコマンドボタンを押すたびにランダムに変わるようになっています。


sheet3は名詞の単語が1551個収録、sheets4は形容詞の単語が792個収録、sheets5は動詞の単語が
1059個収録、sheets6は副詞の単語が61個収録といった構成です。


userform1には問題数表示と問題文のラベルと4つのコマンドボタンが設置してあり3つは問題の回答選択支としてのボタンで
残りの1つは次の問題へと進むためのボタンです。

下にuserform1のcommandbutton1~4までのプログラムを載せます。



Private Sub CommandButton1_Click()
Application.ScreenUpdating = False

If Label4.Caption = "正解!!" Or Label4.Caption = "残念!!" Then
CommandButton4.SetFocus

ElseIf Label5.Caption = "1" Or Label5.Caption = "2" Or Label5.Caption = "3" Or Label5.Caption = "4" Or Label5.Caption = "5" Or Label5.Caption = "6" Then

Label4.Caption = "正解!!"
Sheets("処理").Select
Cells(2, 3) = Cells(2, 3) + 1
Sheets("スタート").Select

CommandButton1.Caption = Empty
CommandButton2.Caption = Empty
CommandButton3.Caption = Empty

If Label2 = "20" Then
MsgBox "全20問終了しました。"
End If

Else
Sheets("処理").Select
Label4.Caption = "残念!!" & vbCrLf & Cells(Label2 + 1, 16).Value
Sheets("スタート").Select

CommandButton1.Caption = Empty
CommandButton2.Caption = Empty
CommandButton3.Caption = Empty

If Label2 = "20" Then
MsgBox "全20問終了しました。"
End If
End If
Application.ScreenUpdating = True

CommandButton4.SetFocus

End Sub




Private Sub CommandButton2_Click()
Application.ScreenUpdating = False

If Label4.Caption = "正解!!" Or Label4.Caption = "残念!!" Then
CommandButton4.SetFocus

ElseIf Label5.Caption = "7" Or Label5.Caption = "8" Or Label5.Caption = "13" Or Label5.Caption = "14" Or Label5.Caption = "19" Or Label5.Caption = "20" Then
Label4.Caption = "正解!!"
Sheets("処理").Select
Cells(2.3) = Cells(2, 3) + 1
Sheets("スタート").Select

CommandButton1.Caption = Empty
CommandButton2.Caption = Empty
CommandButton3.Caption = Empty

If Label2 = "20" Then
MsgBox "全20問終了しました"
End If

Else
Sheets("処理").Select
Label4.Caption = "残念!!" & vbCrLf & Cells(Label2 + 1, 16).Value
Sheets("スタート").Select
CommandButton1.Caption = Empty
CommandButton2.Caption = Empty
CommandButton3.Caption = Empty



If Label2 = "20" Then
MsgBox "全20問終了しました。"
End If

End If
Application.ScreenUpdating = True

CommandButton4.SetFocus

End Sub


Private Sub commandbutton3_click()
Application.ScreenUpdating = False
If Label4.Caption = "正解!!" Or Label4.Caption = "残念!!" Then
CommandButton4.SetFocus

ElseIf Label5.Caption = "9" Or Label5.Caption = "11" Or Label5.Caption = "15" Or Label5.Caption = "17" Or Label5.Caption = "21" Or Label5.Caption = "23" Then

Label4.Caption = "正解!!"
Sheets("処理").Select
Cells(2, 3) = Cells(2, 3) + 1
Sheets("スタート").Select

CommandButton1.Caption = Empty
CommandButton2.Caption = Empty
CommandButton3.Caption = Empty

If Label2 = "20" Then
MsgBox "全20問終了しました"
End If

Else
Sheets("処理").Select
Label4.Caption = "残念!!" & vbCrLf & Cells(Label2 + 1, 16).Value
Sheets("スタート").Select
CommandButton1.Caption = Empty
CommandButton2.Caption = Empty
CommandButton3.Caption = Empty


If Label2 = "20" Then
MsgBox "全20問終了しました。"
End If

End If

Application.ScreenUpdating = True

CommandButton4.SetFocus



End Sub





commndbutton4のプログラムも載せます。
全部載せると文字数が足らないので膨大なcaptionの部分は省きます。

Private Sub CommandButton4_Click()
Dim 正解率 As Variant

Application.ScreenUpdating = False
If Left(Label4.Caption, 4) = "正解!!" Or Left(Label4.Caption, 4) = "残念!!" Then

If Label2 = "20" Then
Sheets("処理").Select
正解率 = Cells(2, 3) / 20 * 100
Label4.Caption = "正解率は" & 正解率 & "%でした。"
Sheets("スタート").Select
MsgBox "全20問終了しました。"
Unload Me
Exit Sub
End If

Label2.Caption = Label2 + 1
Sheets("処理").Select

Label4.Caption = Cells(Label2 + 1, 11)
Label5.Caption = Cells(Label2 + 1, 4).Value

省略



End If
Else
MsgBox "解答を選択して下さい!!", vbCritical
End If
Sheets("スタート").Select
Application.ScreenUpdating = True

End Sub

#1で十分だと思いますが、GetAsyncKeyState APIを使ってやってみました。
参考URLの他、VBAのヘルプの「RaiseEvent ステートメントの使用例」をご参照下さい。
とりあえず動いたという以上の検証は出来ておりません。
また、CommandButton1のところしか記載しておりませんので悪しからず。
☆標準モジュール
Sub test()
UserForm1.Show
End Sub

☆UserForm1モジュール
Private WithEvents watchKey As Class1

Private Sub CommandButton1_Click()
MsgBox "CommandButton1が押されたよ"
End Sub

Private Sub UserForm_Initialize()
Set watchKey = New Class1
End Sub

Private Sub UserForm_Activate()
'これをUserForm_Initializeで実行するとフォームが表示されずはまった...
watchKey.watchTask
End Sub

Private Sub UserForm_Terminate()
watchKey.stopLoop = True
Set watchKey = Nothing
End Sub

Private Sub watchKey_keyPushed(ByVal strKey As String)
'MsgBox strKey & "が押されました"
Select Case strKey
Case "←"
Call CommandButton1_Click
Case "↑"

Case "→"

End Select
End Sub

☆Class1モジュール 中身が分かる名前をつけるのが本来ですが、簡便のため挿入/クラスモジュールでつくお仕着せの名前にしてあります。
Public Event keyPushed(ByVal strKey As String)

Private Declare Function GetAsyncKeyState Lib "User32.dll" (ByVal vKey As Long) As Long
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Const VK_LEFT = &H25 '[←]
Private Const VK_UP = &H26 '[↑]
Private Const VK_RIGHT = &H27 '[→]

Private myStopFlag As Boolean

Public Sub watchTask()
Do
If GetAsyncKeyState(VK_LEFT) Then
RaiseEvent keyPushed("←")
ElseIf GetAsyncKeyState(VK_UP) Then
RaiseEvent keyPushed("↑")
ElseIf GetAsyncKeyState(VK_RIGHT) Then
RaiseEvent keyPushed("→")
Else

End If
Call Sleep(100)
DoEvents
Loop Until myStopFlag
End Sub

Public Property Let stopLoop(stopFlag As Boolean)
myStopFlag = stopFlag
End Property

この回答へのお礼

回答ありがとうございます!
試したのですが、名前が適切ではないとエラーがでてしまいました・・

準備:
UserForm1にCommandButton1,2,3を配置してある(他のコントロールは無い)
プロパティパネルで各コマンドボタンのTabStop並びにTakeFocusOnClickをFalseにしておく

手順:
ユーザーフォームのシートに
Private Sub UserForm_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 If KeyCode = 39 Then CommandButton1_Click
 If KeyCode = 38 Then CommandButton2_Click
 If KeyCode = 37 Then CommandButton3_Click
End Sub

としておく。




#他のコントロールを置かなきゃならないなら,そちらのコントロールもフォーカスを持たないようにするか,またはフォーカスを持つ(可能性のある)コントロールのkeyDownイベントに同じ仕込みをしておくこと

この回答へのお礼

回答ありがとうございます!
早速試して1問目に限れば理想どうりに動いたのですが、2問目からはコマンドボタンに点々の黒枠が
出てしまい方向キーをおしてもクリック動作がせず、黒枠が動くだけになってしまいました・・

このQ&Aは役に立ちましたか?0 件

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

新しく質問する

注目の記事

おしトピにAndroid版アプリが登場

話題のトピックにさくっとコメントできる「おしトピ」に Android版アプリが登場! もっと身近に使いやすくなりました。
今ならダウンロードで話題の掃除ロボットや全天球カメラが 当たるプレゼントキャンペーンも実施中。


新しく質問する

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

毎日見よう!教えて!gooトゥディ