[[20141106112713]]　『Acceleratorキーに割りつけられるキー』（田吾作）　ページの最後に飛ぶ

『Acceleratorキーに割りつけられるキー』（田吾作）

 こんにちは、よろしくお願いいたします。

 ユーザーフォームのコマンドボタン等に
 Acceleratorキーを割りつけて
 Altキー+指定のキーでコマンドボタン等のコードを実行できますが、
 このAcceleratorキーに

 ↑や↓等のキーを割り付けることは可能でしょうか？

 ご指導お願いいたします。

＜使用 Excel：Excel2007、使用 OS：WindowsVista ＞

無理じゃないかな？
Excel2003版のVBAのヘルプには次のようにあります。
「Accelerator プロパティの値として、アクセスキーとする 1 文字を入力します。Accelerator プロパティには、ANSI 文字のみ設定できます。」

（みやほりん） 2014/11/06(木) 11:41

 やってみたけど出来なさそうだねぇ。
 ちなみになんで矢印キーが必要なの？

 場合によってはキーダウンイベントを拾うっていうのもありだと思うんだけど・・・
（稲葉） 2014/11/06(木) 11:44

稲葉さん案の、キー入力を拾う例。
（上下キーでなければ、KeyUpイベントのほうが良いと思う）

 Private Sub CommandButton1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Select Case KeyCode
    Case vbKeyMenu
        CommandButton1.Caption = "ALT"
    Case vbKeyUp
        CommandButton1.Caption = "↑"
    Case vbKeyDown
        CommandButton1.Caption = "↓"
    Case vbKeyLeft
        CommandButton1.Caption = "←"
    Case vbKeyRight
        CommandButton1.Caption = "→"
    End Select
End Sub
（???） 2014/11/06(木) 14:05

 ↑キーではないですが、以前こんな質問に投稿したことがありました。
[[20090110213938]]

 これは、数字キーでしたが、応用してみてください。

 2010で動かしたら、ラベルが暗くて文字が見えませんでした。

 >Private Sub UserForm_Initialize()
 >   Dim btn As MSForms.CommandButton
 >   Dim g0 As Long
 >   Dim lef_array As Variant
 >   lef_array = Array(24, 60, 96)
 >   With Me
 >      .Width = 230
 >      .Height = 228
 >      Set lbl = .Controls.add("Forms.Label.1", , True)
 >      With lbl
 >         .Left = 24
 >         .Top = 24
 >         .Width = 180
 >         .Height = 24
           .BackColor = vbwhite

 と訂正して試してみてください

（ichinose） 2014/11/06(木) 20:06

 みやほりんさん、稲葉さん、???さん、ichinoseさん、ご回答ありがとうございます。

 何故こういうことをしたかったかの経緯です。

 最近、タッチパッド付きワイヤレスミニキーボードを購入しました。
 使いやすいのですが、タッチパッドでのマウスカーソル移動が動かしにくい、という
 問題がありました。慣れてきたらそれほどでもなくくなってきましたが。

 ユーザーフォームのスピンボタンまでマウスカーソルを移動し、スピンボタンの↑↓
 ボタンをクリックする(スピンボタンの↑↓ボタンをクリックすることでリストボック
 スの選択行を上下に遷移させています。)、という作業をショートカットキーで出来な
 いか、と探していたらAcceleratorキーというのがあるのを知りました。

 そこで、Acceleratorキーに↑↓キーを割り付けられないか、と考えました。
 そこで質問させていただきました。

 でも、そもそもスピンボタンにはAcceleratorキーは割り付けられないのですね。
 また、↑↓キーもAcceleratorキーには割り付けられないこともご教示により
 分かりました。

 そこで、ユーザーフォームに↓のように記述することで↑↓キーでリストボックスの
 選択行を上下に遷移させることが出来ました。

 ※リストボックスの選択行を上下に遷移させることは元々↑↓キーで出来るのですが、
 カーソルが一番上や一番下まで来たときはそこで止まってしまうのを回避して、一番
 上にあるときに↑キーを押すことで一番下へ遷移、一番下にあるときに↓キーを押す
 ことで一番上へ遷移、が出来るようにしました。
 ↓はスピンボタンに記述しているコードです。これを↑↓キーでも実現できるように
 した、ということです。

 ------------------
Private Sub SpinButton1_SpinDown()
 Dim i As Long
 If Me.ListBox1.ListCount = 0 Then Exit Sub
 With Me.ListBox1
 If .Selected(.ListCount - 1) = True Then
 .Selected(0) = True
 Else
  For i = 0 To .ListCount - 2
     If .Selected(i) = True Then
     .Selected(i + 1) = True
     Exit For
     End If
  Next i
  End If
 End With
End Sub

Private Sub SpinButton1_SpinUp()

 Dim i As Long
 If Me.ListBox1.ListCount = 0 Then Exit Sub
 With Me.ListBox1
  If .Selected(0) = True Then
  .Selected(.ListCount - 1) = True
  Else
  For i = 1 To .ListCount - 1
     If .Selected(i) = True Then
     .Selected(i - 1) = True
     Exit For
     End If
  Next i
  End If
 End With
End Sub
 ----------------------------

↓が↑↓キーによるリストボックスのカーソルが一番上、一番下にあるときのカーソル遷移の
コードです。

 -------------------------------

Dim lb1indx As Integer

'カーソルが２行遷移することを回避するためのコード
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

 lb1indx = Me.ListBox1.ListIndex
End Sub

'↑↓キーによるリストボックスのカーソルが一番上、一番下にあるときのカーソル遷移するためのコード
Private Sub ListBox1_KeyUp(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)

 'Application.EnableEvents = False
 Select Case KeyCode
  Case vbKeyUp
   If lb1indx = 0 Then
      If Me.ListBox1.ListIndex = 0 Then Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 1
   End If
  Case vbKeyDown
   If lb1indx = Me.ListBox1.ListCount - 1 Then
      If Me.ListBox1.ListIndex = Me.ListBox1.ListCount - 1 Then Me.ListBox1.ListIndex = 0
   End If
 End Select
 'Application.EnableEvents = True
End Sub

'リストボックス上でマウスカーソルを動かすことでリストボックスにフォーカスを移す
Private Sub ListBox1_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

 Me.ListBox1.SetFocus
End Sub
 ----------------------------------

勉強の為、
[[20090110213938]]
のコードを0-9まで増やしてみました。

' Userform1のモジュール

 '==================================================================
 Option Explicit
 Private WithEvents contev As Class1
 Private lbl As MSForms.Label
 '==================================================================
 Private Sub contev_cclick(id As Long)
    lbl.Caption = lbl.Caption & CStr(id)
 End Sub
 '==================================================================
 Private Sub UserForm_Initialize()
    Dim btn As MSForms.CommandButton
    Dim g0 As Long
    Dim i As Integer
    Dim lef_array() As Variant
    Dim num As Integer
    Dim wd As Integer
    Dim lt As Integer
     num = 8
     wd = 36
     lt = 24
     For i = -1 To num
      ReDim Preserve lef_array(i + 1)
      lef_array(i + 1) = 24 + (i + 1) * wd
     Next i
    With Me
       .Width = lt + wd * (num + 3)
       .Height = 228
       Set lbl = .Controls.add("Forms.Label.1", , True)
       With lbl
          .Left = lt
          .Top = 24
          .Width = wd * (num + 2)
          .Height = 24
          .BackColor = &H80000009
          .SpecialEffect = 2
          .Font.Size = 12
          .TextAlign = 3
       End With
       Set contev = New Class1
       For g0 = -1 To num
          Set btn = .Controls.add("Forms.Commandbutton.1", , True)
          btn.Left = lef_array(g0 + 1)
          btn.Top = 60
          btn.Width = wd
          btn.Height = 30
          btn.TabStop = False
          btn.TakeFocusOnClick = False
          btn.Caption = StrConv(CStr(g0 + 1), 4)
          contev.add 3, g0 + 1, btn
       Next
    End With
 End Sub

'==================================================================

Private Sub UserForm_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)

 Dim mynum As Integer
   If KeyAscii >= Asc("0") And KeyAscii <= Asc("9") Then
      mynum = KeyAscii - Asc("0") + 1
      With Controls("commandbutton" & mynum)
         .SetFocus
         SendKeys Chr(13)
         DoEvents
         .Visible = False
         .Visible = True
         End With
    End If
 End Sub

'Class1のクラスモジュール

 '=====================================================================
 Option Explicit
 Event cclick(id As Long)
 Private c_controls As Collection
 '=====================================================================
 Private Sub Class_Initialize()
   Set c_controls = New Collection
 End Sub
 '=====================================================================
 Private Sub Class_Terminate()
   Set c_controls = Nothing
 End Sub
 '=====================================================================
 Sub btn_click(id As Long)
   RaiseEvent cclick(id)
 End Sub
 '=====================================================================
 Sub add(typ As Long, id As Long, obj1 As Object)
 ' typ 1:textbox 2:combobox 3:commandbutton 4:Label
 '今のところ、3のcommandbuttonだけ
   Dim btn As Class2
   Select Case typ
     Case 3
       Set btn = New Class2
       btn.set_controls id, obj1, Me
       c_controls.add btn
     End Select
 End Sub

' Class2のクラスモジュール

 '=====================================================
 Option Explicit
 Private WithEvents btn As MSForms.CommandButton
 Private id As Long
 Private pa_obj As Object
 Private Sub btn_click()
   pa_obj.btn_click id
 End Sub
 '=====================================================
 Sub set_controls(idx As Long, obj1 As MSForms.CommandButton, obj2 As Object)
   Set btn = obj1
   id = idx
   Set pa_obj = obj2
 End Sub

 ---------------------

 おかげさまで解決しました。ありがとうございました。
（田吾作） 2014/11/08(土) 00:03

コメント返信：

[ 一覧(最新更新順) ]

[[20141106112713]] 『Acceleratorキーに割りつけられるキー』（田吾作） ページの最後に飛ぶ

[[20141106112713]]　『Acceleratorキーに割りつけられるキー』（田吾作）　ページの最後に飛ぶ