えくせるちゅんちゅん

ことりがエクセルをちゅんちゅんするブログ

トップ > VBA > VBAでリストボックスを上下するボタンを作成する方法

VBAでリストボックスを上下するボタンを作成する方法

VBA VBAフォーム

VBAのユーザーフォームに配置されたリストボックスのアイテムをボタンクリックで上下できるフォームを作成したので紹介する。

作ったもの

f:id:Kotori-ChunChun:20210613231123g:plain

  1. リストボックスのアイテムは複数選択・2列表示できるようにする
  2. 【追加】を押したらテキストボックスの文字列をリストボックスにアイテムを追加する。ただし、もしスペースで区切られている場合は2列に分割する
  3. 【削除】を押したら選択しているアイテムを削除する
  4. 複数のアイテムを【上ボタン】【下ボタン】によって上下移動できるようにする
  5. 【スピンボタン（アップダウンボタンとも言う）】を使うことで、クリック連打や長押しによる上下移動もできるようにする


リストボックスのアイテムは複数選択・2列表示できるようにする

Private Sub UserForm_Initialize()
    lb.MultiSelect = fmMultiSelectMulti
    lb.ColumnCount = 2
End Sub

フォームデザイナ上でも設定可能ですが、VBAのフォームデザインはコードで確認できないのが不便なため、極力コードで書くようにしています。（その方が差分管理もしやすい）

こういったプロパティ設定は、コンストラクタ UserForm_Initialize（フォームオブジェクト生成時）に行います。


MultiSelect には3つの選択肢があります。

  • fmMultiSelectSingle 一個しか選択できない
  • fmMultiSelectExtended 一個選択が基本だが、CtrlやShiftと組み合わせれば複数選択可能
  • fmMultiSelectMulti 複数選択が基本で、選択するたびに選択状態がトグルする

今回は複数選択を主目的としていたので、fmMultiSelectMultiを使用しました。


ColumnCountは標準は1ですが、数値を増やすことでリストボックスの列数を増やすことが出来ます。

今回は検証用なので2を設定しておきました。


【追加】を押したらテキストボックスの文字列をリストボックスにアイテムを追加する。ただし、もしスペースで区切られている場合は2列に分割する

まずはUI部分

Private Sub btnAdd_Click()
    tb.SetFocus
    If tb.Text = "" Then Exit Sub
    Call ListBox_AddItem(lb, Split(tb.Text, " "))
    tb.Text = ""
End Sub
  • 使いやすいようにテキストボックスにフォーカスを与えること
  • 空欄なら無視
  • スペースで区切った配列を渡してアイテムをAddItem（自作関数へ）
  • テキストボックスを空欄へ


次にAddItemの中身ですが

Rem リストボックスにアイテムを追加する
Rem   @param lb                    対象ListBox
Rem   @param insertRowData         値または一次元配列データ
Rem   @param insertRowIndex        挿入する行インデックス（0~）（既定：-1 最後に追加）
Rem   @return As Long              挿入された行インデックス
Public Function ListBox_AddItem(lb As MSForms.ListBox, insertRowData, Optional ByVal insertRowIndex As Long = -1) As Long
    If insertRowIndex = -1 Then
        insertRowIndex = lb.ListCount
    End If

    If Not IsArray(insertRowData) Then
        lb.AddItem insertRowData, insertRowIndex
        ListBox_AddItem = insertRowIndex
        Exit Function
    End If

    lb.AddItem "", insertRowIndex
    Dim ColumnIndex As Long, itemIndex As Long
    itemIndex = LBound(insertRowData)
    For ColumnIndex = 0 To lb.ColumnCount - 1
        If ColumnIndex <= UBound(insertRowData) Then
            lb.List(insertRowIndex, ColumnIndex) = insertRowData(itemIndex)
        End If
        itemIndex = itemIndex + 1
    Next
    ListBox_AddItem = insertRowIndex
End Function

insertRowData が非配列なら lb.AddItem insertRowData して完了です。

しかし、lb.AddItem で配列が渡せないため、今回のように複数列をサポートする場合は少々面倒なコードを書く必要があります。

  1. lb.AddItem "" する
  2. lb.List(row,col) = arr(col) という感じで1列づつ文字列を更新

なお、リストボックスのデータ読み書きは、通常 lb.List(インデックス) と書きますが、実は第二引数に 0 が隠れています。1行目の2列目は lb.List(0, 1) と書きます。ちなみにインデックスは0から始まります。


【削除】を押したら選択しているアイテムを削除する

Private Sub btnDel_Click()
    Call ListBox_RemoveSelectedItems(lb)
End Sub

Rem リストボックスの選択中アイテムを削除する
Rem   @param lb                    対象ListBox
Public Sub ListBox_RemoveSelectedItems(lb As MSForms.ListBox)
    Dim i As Long
    For i = lb.ListCount - 1 To 0 Step -1
        If lb.Selected(i) Then lb.RemoveItem i
    Next
End Sub

削除で気をつけたいことは、ループが逆順ということです。

RemoveItemするとインデックスがズレてしまうため、末尾から先頭に向かって消していったほうが簡単に書けます。


複数のアイテムを【上ボタン】【下ボタン】によって上下移動できるようにする

まずはUI部分

Private Sub btnDown_Click()
    Call ListBox_MoveDownSelectedItems(lb)
End Sub

Private Sub btnUp_Click()
    Call ListBox_MoveUpSelectedItems(lb)
End Sub

次にアイテムを上へ移動するロジック部分 ListBox_MoveUpSelectedItems

Rem リストボックスの選択中アイテムを1つ上に移動する
Rem   @param lb                    対象ListBox
Public Sub ListBox_MoveUpSelectedItems(lb As MSForms.ListBox)
    
    'リストボックスアイテムの最大インデックス値（要素数-1）
    Dim MAX_INDEX As Long: MAX_INDEX = lb.ListCount - 1
    
    'アイテムを上から順に最後から2番目のアイテムまで巡回
    Dim i As Long
    For i = 0 To MAX_INDEX - 1
    
        '現在のアイテムが非選択状態で、次のアイテムが選択状態なら入れ替えを実行
        If Not lb.Selected(i) And lb.Selected(i + 1) Then
        
            '末尾に到達するか非選択アイテムが見つかるまで繰り返す
            Do
                If i >= MAX_INDEX Then Exit Do
                If Not lb.Selected(i + 1) Then Exit Do
                
                '全ての列を繰り返す
                Dim j As Long
                For j = 0 To lb.ColumnCount - 1
                    
                    '上下の行の文字列を入れ替える
                    Dim txt1 As Variant: txt1 = lb.List(i + 0, j)
                    Dim txt2 As Variant: txt2 = lb.List(i + 1, j)
                    lb.List(i + 0, j) = IIf(IsNull(txt2), "", txt2)
                    lb.List(i + 1, j) = IIf(IsNull(txt1), "", txt1)
                Next
                
                '上下の行の選択状態を入れ替える
                lb.Selected(i + 0) = True
                lb.Selected(i + 1) = False
                
                i = i + 1
            Loop
        End If
    Next
    
End Sub

細かいロジックはコード内記載の通りですが、厄介なのは

  • 行も列もインデックスが0始まりであること
  • 列の要素数が揃っているとは限らない（ lb.List は 二次元配列ではない）こと
  • Nullの要素にNullを代入できないこと（理由は不明）
  • 上下でループの方向、カウンタをインクリメントする方向、終了条件が真逆となるため、プロシージャを1つにまとめると可読性が落ちやすいこと（だから別々に作成してます）

など。


【スピンボタン（アップダウンボタンとも言う）】を使うことで、クリック連打や長押しによる上下移動もできるようにする

先の方法ではコマンドボタンを使用していますが、コマンドボタンは使いづらい罠があります。

実際に設置してみると分かりますが、高速で2回クリックすると二度目はクリックイベントが起きません。（ダブルクリックとして認識されている。その証拠にスペースキーなら高速連打できる）


今回の場合は、ダブルクリックイベントでもシングルクリックイベントに投げれば一応回避が可能です。

Private Sub btnDown_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call btnDown_Click
End Sub

Private Sub btnUp_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    Call btnUp_Click
End Sub

しかし、なんだか気持ちが悪いのと、長押しで一気に移動できないため直感的とは言えません。


そこで、スピンボタンを使います。

Private Sub spinUpDown_SpinDown()
    Call ListBox_MoveDownSelectedItems(lb)
End Sub

Private Sub spinUpDown_SpinUp()
    Call ListBox_MoveUpSelectedItems(lb)
End Sub

重要なのは SpinDown と SpinUp を使うということ。

スピルボタンをダブルクリックしたときは SpinChange イベントしか出てこないため、意外と見落としがちなイベントです。（一時期Changeで実装したことがあり、増減の識別、コードからの値変更の識別、最低値・最大値・現在値の初期化など中々のコード量になりました）

これで、難しいコードを書かずとも、直感的にスムーズな増減ボタンが作れます。


ソースコード全文

Option Explicit

Private Sub btnAdd_Click()
    tb.SetFocus
    If tb.Text = "" Then Exit Sub
    Call ListBox_AddItem(lb, Split(tb.Text, " "))
    tb.Text = ""
End Sub

Private Sub btnDel_Click()
    Call ListBox_RemoveSelectedItems(lb)
End Sub

Private Sub btnDown_Click()
    Call ListBox_MoveDownSelectedItems(lb)
End Sub

Private Sub btnUp_Click()
    Call ListBox_MoveUpSelectedItems(lb)
End Sub

Private Sub spinUpDown_SpinDown()
    Call ListBox_MoveDownSelectedItems(lb)
End Sub

Private Sub spinUpDown_SpinUp()
    Call ListBox_MoveUpSelectedItems(lb)
End Sub

Private Sub UserForm_Initialize()
    lb.MultiSelect = fmMultiSelectMulti
    lb.ColumnCount = 2
End Sub

Rem リストボックスにアイテムを追加する
Rem   @param lb                    対象ListBox
Rem   @param insertRowData         一次元配列データ
Rem   @param insertRowIndex        挿入する行インデックス（0~）（既定：-1 最後に追加）
Rem   @return As Long              挿入された行インデックス
Public Function ListBox_AddItem(lb As MSForms.ListBox, insertRowData, Optional ByVal insertRowIndex As Long = -1) As Long
    If insertRowIndex = -1 Then
        insertRowIndex = lb.ListCount
    End If

    If Not IsArray(insertRowData) Then
        lb.AddItem insertRowData, insertRowIndex
        ListBox_AddItem = insertRowIndex
        Exit Function
    End If

    lb.AddItem "", insertRowIndex
    Dim ColumnIndex As Long, itemIndex As Long
    itemIndex = LBound(insertRowData)
    For ColumnIndex = 0 To lb.ColumnCount - 1
        If ColumnIndex <= UBound(insertRowData) Then
            lb.List(insertRowIndex, ColumnIndex) = insertRowData(itemIndex)
        End If
        itemIndex = itemIndex + 1
    Next
    ListBox_AddItem = insertRowIndex
End Function

Rem リストボックスの選択中アイテムを削除する
Rem   @param lb                    対象ListBox
Public Sub ListBox_RemoveSelectedItems(lb As MSForms.ListBox)
    Dim i As Long
    For i = lb.ListCount - 1 To 0 Step -1
        If lb.Selected(i) Then lb.RemoveItem i
    Next
End Sub

Rem リストボックスの選択中アイテムを1つ上に移動する
Rem   @param lb                    対象ListBox
Public Sub ListBox_MoveUpSelectedItems(lb As MSForms.ListBox)
    
    Dim MAX_INDEX As Long: MAX_INDEX = lb.ListCount - 1
    
    Dim i As Long
    For i = 0 To MAX_INDEX - 1
        If Not lb.Selected(i) And lb.Selected(i + 1) Then
            Do
                If i >= MAX_INDEX Then Exit Do
                If Not lb.Selected(i + 1) Then Exit Do
                
                Dim j As Long
                For j = 0 To lb.ColumnCount - 1
                    Dim txt1 As Variant: txt1 = lb.List(i + 0, j)
                    Dim txt2 As Variant: txt2 = lb.List(i + 1, j)
                    lb.List(i + 0, j) = IIf(IsNull(txt2), "", txt2)
                    lb.List(i + 1, j) = IIf(IsNull(txt1), "", txt1)
                Next
                lb.Selected(i + 0) = True
                lb.Selected(i + 1) = False
                
                i = i + 1
            Loop
        End If
    Next
    
End Sub

Rem リストボックスの選択中アイテムを1つ下に移動する
Rem   @param lb                    対象ListBox
Public Sub ListBox_MoveDownSelectedItems(lb As MSForms.ListBox)
    
    Dim MIN_INDEX As Long: MIN_INDEX = 0
    
    Dim i As Long
    For i = lb.ListCount - 1 To MIN_INDEX + 1 Step -1
        If Not lb.Selected(i) And lb.Selected(i - 1) Then
            Do
                If i <= MIN_INDEX Then Exit Do
                If Not lb.Selected(i - 1) Then Exit Do
                
                Dim j As Long
                For j = 0 To lb.ColumnCount - 1
                    Dim txt1 As Variant: txt1 = lb.List(i - 0, j)
                    Dim txt2 As Variant: txt2 = lb.List(i - 1, j)
                    lb.List(i - 0, j) = IIf(IsNull(txt2), "", txt2)
                    lb.List(i - 1, j) = IIf(IsNull(txt1), "", txt1)
                Next
                lb.Selected(i - 0) = True
                lb.Selected(i - 1) = False
                
                i = i - 1
            Loop
        End If
    Next
    
End Sub


まとめ

ありがちな処理だと思いますが、検索しても良さげな記事が見当たらなかったので書いてみました。

誰かの参考になれば幸いです。

以上

何か御座いましたらコメント欄、またはTwitterからどうぞ♪

それではまた来週♪　ちゅんちゅん(・8・)