[[20220326220617]]　『vba リストボックス内のリストをエンターキーで移』（jjj）　ページの最後に飛ぶ

『vba リストボックス内のリストをエンターキーで移動させる』（jjj）

はじめまして。
リストボックス内に表示されたリストをエンターキーを押す事により
下に移動することはVBaではなく可能でしょうか？
もしよろしければどのようなコードか教えていただけると助かります。
ダメならヒントでも構わないです。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

すみません。言い忘れました。
エンターキーで下に移動させてスペースキーで選択できるようにしたいです。
選択というのはマウスのダブルクリックなような事です。
下に移動はマウスのホイールなような事です。
失礼します。
（jjj） 2022/03/26(土) 22:30

 ユーザーフォーム上のリストボックスなら

 Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    With Me.ListBox1
        If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then    'EnterキーまたはTabキー
            If .ListIndex = -1 Then
                .ListIndex = 0
            ElseIf .ListCount - 1 = .ListIndex Then
                .ListIndex = 0
            Else
                .ListIndex = .ListIndex + 1
            End If
            KeyCode = 0
        ElseIf KeyCode = vbKeySpace Then  'Spaceキー
            If .ListIndex <> -1 Then
                'セルに転記
                Worksheets("Sheet1").Range("B1").Value = .List(.ListIndex)
            End If
            KeyCode = 0
        End If
    End With
 End Sub

（ピンク） 2022/03/27(日) 11:02

下に移動することはVBaではなく可能でしょうか？もしよろしければどのようなコードか教えていただけると助かります。

VBAではなく、なのに、どのようなコード、とな
矛盾してませんか？

一般機能で実現したいのでしょうか？
マクロで実現したいのでしょうか？
（通りすがり） 2022/03/27(日) 21:43

おはようございます。

ピンクさんのコードを参照に
以下のように組んだのですが
エンターキー押しても
下に進みませんでした。
どこがおかしいのでしょうか？
Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
Dim buf As String
'リストボックスの値を変数bufに格納する

 buf = Me.ListBox1.Value
    With Me.ListBox1
        If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then    'EnterキーまたはTabキー
            If .ListIndex = -1 Then
                .ListIndex = 0
            ElseIf .ListCount - 1 = .ListIndex Then
                .ListIndex = 0
            Else
                .ListIndex = .ListIndex + 1
            End If
            KeyCode = 0
        ElseIf KeyCode = vbKeySpace Then  'Spaceキー
            If .ListIndex <> -1 Then
                'セルに転記
                Worksheets("一時保管").Range("C16").Value = ListBox1
            End If
            KeyCode = 0
        End If
    End With
    If StrPtr(TextBox1) = 0 Then Exit Sub
Dim string1 As String '入力バーコード
Dim string2 As String '登録バーコード1
Dim string3 As String '登録バーコード2
Dim string4 As String '登録バーコード3
Dim string5 As String '登録バーコード4
Dim string6 As String '登録バーコード5
string1 = Worksheets("一時保管").Range("C18")
string2 = Worksheets("一時保管").Range("E18")
string3 = Worksheets("一時保管").Range("F18")
string4 = Worksheets("一時保管").Range("G18")
string5 = Worksheets("一時保管").Range("H18")
string6 = Worksheets("一時保管").Range("I18")
If string1 = string2 Or string1 = string3 Or string1 = string4 Or string1 = string5 Or string1 = string6 Then

Dim rngSearch1 As Range
Dim myRange1 As Range

    Set myRange1 = Worksheets("一時保管").Range("L:L")
    Set rngSearch1 = myRange1.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) 'FAシリーズ
   If rngSearch1 Is Nothing = False Then
UserForm3.Show
Else
Dim rngSearch2 As Range
Dim myRange2 As Range
    Set myRange2 = Worksheets("一時保管").Range("M:M")
    Set rngSearch2 = myRange2.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) 'Infinion
    If rngSearch2 Is Nothing = False Then
UserForm1.Show
Else
Dim rngSearch3 As Range
Dim myRange3 As Range
    Set myRange3 = Worksheets("一時保管").Range("N:N")
    Set rngSearch3 = myRange3.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) 'Cosmo Electronics
    If rngSearch3 Is Nothing = False Then
UserForm5.Show
Else
Dim rngSearch4 As Range
Dim myRange4 As Range
    Set myRange4 = Worksheets("一時保管").Range("O:O")
    Set rngSearch4 = myRange4.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) 'CHENMKO
    If rngSearch4 Is Nothing = False Then
UserForm6.Show
Else
Dim rngSearch5 As Range
Dim myRange5 As Range
    Set myRange5 = Worksheets("一時保管").Range("P:P")
    Set rngSearch5 = myRange5.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) 'Chicago Tribune

    If rngSearch5 Is Nothing = False Then
UserForm7.Show
Else
Dim rngSearch6 As Range
Dim myRange6 As Range
    Set myRange6 = Worksheets("一時保管").Range("Q:Q")
    Set rngSearch6 = myRange6.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) 'Maxim Integrated

    If rngSearch6 Is Nothing = False Then
UserForm8.Show
Else
Dim rngSearch7 As Range
Dim myRange7 As Range
    Set myRange7 = Worksheets("一時保管").Range("R:R")
    Set rngSearch7 = myRange7.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) 'NexPeria

    If rngSearch7 Is Nothing = False Then
UserForm9.Show
Else
Dim rngSearch8 As Range
Dim myRange8 As Range
    Set myRange8 = Worksheets("一時保管").Range("S:S")
    Set rngSearch8 = myRange8.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) 'Walsin

    If rngSearch8 Is Nothing = False Then
UserForm10.Show
Else
Dim rngSearch9 As Range
Dim myRange9 As Range
    Set myRange9 = Worksheets("一時保管").Range("T:T")
    Set rngSearch9 = myRange9.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) '京セラ

    If rngSearch9 Is Nothing = False Then
UserForm11.Show
Else
Dim rngSearch10 As Range
Dim myRange10 As Range
    Set myRange10 = Worksheets("一時保管").Range("U:U")
    Set rngSearch10 = myRange10.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) '新日本無線

    If rngSearch10 Is Nothing = False Then
UserForm12.Show
Else
Dim rngSearch11 As Range
Dim myRange11 As Range
    Set myRange11 = Worksheets("一時保管").Range("V:V")
    Set rngSearch11 = myRange11.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) '太陽誘電

    If rngSearch11 Is Nothing = False Then
UserForm13.Show
Else
Dim rngSearch12 As Range
Dim myRange12 As Range
    Set myRange12 = Worksheets("一時保管").Range("W:W")
    Set rngSearch12 = myRange12.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) '東芝

    If rngSearch12 Is Nothing = False Then
UserForm14.Show
Else
Dim rngSearch14 As Range
Dim myRange14 As Range
    Set myRange14 = Worksheets("一時保管").Range("Y:Y")
    Set rngSearch14 = myRange14.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) '日本ケミコン
    If rngSearch14 Is Nothing = False Then
UserForm16.Show
Else
Dim rngSearch15 As Range
Dim myRange15 As Range
    Set myRange15 = Worksheets("一時保管").Range("Z:Z")
    Set rngSearch15 = myRange15.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) '九州電通
    If rngSearch15 Is Nothing = False Then
UserForm17.Show
Else
Dim rngSearch18 As Range
Dim myRange18 As Range
    Set myRange18 = Worksheets("一時保管").Range("AA:AA")
    Set rngSearch18 = myRange18.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) '送りスピード
    If rngSearch18 Is Nothing = False Then
UserForm18.Show
Else

Dim rngSearch19 As Range
Dim myRange19 As Range

    Set myRange19 = Worksheets("一時保管").Range("AB:AB")
    Set rngSearch19 = myRange19.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) '部品高さ相違
    If rngSearch19 Is Nothing = False Then
UserForm19.Show
Else
Dim rngSearch20 As Range
Dim myRange20 As Range
    Set myRange20 = Worksheets("一時保管").Range("AC:AC")
    Set rngSearch20 = myRange20.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) '専用フィーダー
    If rngSearch20 Is Nothing = False Then
UserForm20.Show
Else
Dim rngSearch21 As Range
Dim myRange21 As Range
    Set myRange21 = Worksheets("一時保管").Range("AD:AD")
    Set rngSearch21 = myRange21.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) 'CCDレベル差異
    If rngSearch21 Is Nothing = False Then
UserForm21.Show
Else
Dim rngSearch16 As Range
Dim myRange16 As Range
    Set myRange16 = Worksheets("部品Z軸検索").Range("O:O")
    Set rngSearch16 = myRange16.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) '担当者
    If rngSearch16 Is Nothing = False Then
UserForm4.Show '担当者
Else
Dim rngSearch17 As Range
Dim myRange17 As Range
    Set myRange17 = Worksheets("一時保管").Range("Z:Z")
    Set rngSearch17 = myRange17.Find(What:=Worksheets("部品Z軸検索").Range("B3"), LookAt:=xlWhole) '入力ミス
    If rngSearch17 Is Nothing Then

End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If

Unload Me

Else
Unload Me
UserForm24.Show
End If

End Sub

Private Sub TextBox1_Change()
'テキストボックスの内容が変化したときに実行するコード
Dim lstDat As Variant
Dim buf As String, bufLen As Integer
Dim rowEnd As Long
Dim i As Long
'D列の最終行を調べ、変数lstDatにD列の値を格納
With ThisWorkbook.Worksheets("部品Z軸検索")
rowEnd = .Cells(Rows.Count, 21).End(xlUp).Row
lstDat = Worksheets("部品Z軸検索").Range(.Cells(1, 21), .Cells(rowEnd, 21)).Value
End With
'テキストボックスの内容と文字数を変数buf,bufLenに格納
buf = Me.TextBox1
bufLen = Len(buf)
'リストボックスの内容を初期化
Me.ListBox1.Clear
'テキストボックスの文字数が0の場合終了
If bufLen = 0 Then Exit Sub
'テキストボックスの内容とlstDatの内容を比較する
For i = 1 To rowEnd
'一致した場合にリストボックスに値を追加する
If buf = Left(lstDat(i, 1), bufLen) Then
Me.ListBox1.AddItem lstDat(i, 1)
End If
Next i
End Sub

通りすがりさん
こちらの打ち間違いです。
VBAで実現したいの間違いでした。
（jjj） 2022/03/28(月) 07:16

ListBoxがMultiSelectになっていませんか？

（tkit） 2022/03/28(月) 08:44

 >エンターキー押しても下に進みませんでした。

 Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Dim buf As String
    'リストボックスの値を変数bufに格納する
    buf = Me.ListBox1.Value

 KeyDownが起動した時点ではListBox1に項目が取得できていないのでエラーで止まっているのでは

 Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    With Me.ListBox1
        If KeyCode = vbKeyReturn Or KeyCode = vbKeyTab Then    'EnterキーまたはTabキー
            If .ListIndex = -1 Then
                .ListIndex = 0
            ElseIf .ListCount - 1 = .ListIndex Then
                .ListIndex = 0
            Else
                .ListIndex = .ListIndex + 1
            End If
        ElseIf KeyCode = vbKeySpace Then  'Spaceキー
            If .ListIndex <> -1 Then
                'セルに転記
                Worksheets("一時保管").Range("C16").Value = .Value
            End If
        End If
    End With
    KeyCode = 0
    'ここまでは、こちらでは問題なく動作しておりますが
    'これ以降に書かれておられる、なが～いコードにつきましては
    '検証していません
 End Sub

（ピンク） 2022/03/28(月) 09:32

ピンクさん

 Dim buf As String
    'リストボックスの値を変数bufに格納する
    buf = Me.ListBox1.Value
の後にご指摘のListBox1に項目が取得するをコードを追加すると思うのですが合っていますでしょうか？
（jjj） 2022/03/28(月) 12:33

いろいろ考えみましたが、なかなか上手くいかないので今回は諦めます。
貴重なご意見ありがとうございました。

（jjj） 2022/03/28(月) 21:24

コメント返信：

[ 一覧(最新更新順) ]

[[20220326220617]] 『vba リストボックス内のリストをエンターキーで移』（jjj） ページの最後に飛ぶ

[[20220326220617]]　『vba リストボックス内のリストをエンターキーで移』（jjj）　ページの最後に飛ぶ