VBA ユーザーフォームでDual Listboxを作成

今回紹介するのは、複数アイテムの選択でよく見かけるDual Listbox UI。
f:id:t-hom:20190323193129p:plain

一応説明しておくと、左のリストからアイテムを選択し、右へ移動させ、最終的に右にあるものが選択したアイテムとして扱われるユーザーインターフェースだ。

構造はそれほど難しくないが、作ってみたら意外に手間だったので記事に残しておく。

フォームデザイン

各部のオブジェクト名は次のとおり設定する。
f:id:t-hom:20190323201332p:plain

AvailableListBoxとSelectedListBoxには次の値を設定する。

BorderStyle	1 - fmBorderStyleSingle
MultiSelect	2 - fmMultiSelectExtended

その他、全コントロールのフォントをMeiryo UIに設定する。

TabIndexは次のように設定したが、適宜お好みで良いと思う。
f:id:t-hom:20190323194913p:plain

コード

フォームモジュール DualListBoxForm のコード

このコードのポイントは外部から直接フォームをShowさせるのではなく、OpenForm関数の呼び出しによってフォームモジュール内部からShowさせていること。

通常はメインコードでモーダルフォームをShowし、フォーム操作の後にフォームをHideする。
そのフォームで選択された結果を取得するコードもメインコードに書かなければならない。
しかし今回の方法なら、モーダルフォームのクローズから状態取得までを関数に内包させることができ、メインコードが汚れずに済む。

Option Explicit
Public OKClicked As Boolean

Public Function OpenForm(string_collection As Collection, Optional caption_ As String = "Dual ListBox") As Collection
    Me.Caption = caption_
    Dim ret As Collection
    Dim s
    For Each s In string_collection
        AvailableListBox.AddItem s
    Next
    Me.Show
    If OKClicked Then
        Set ret = New Collection
        Dim i As Long
        For i = 0 To SelectedListBox.ListCount - 1
            ret.Add SelectedListBox.List(i)
        Next
    Else
        'ret keeps Nothing
    End If
    Set OpenForm = ret
    Unload Me
End Function

Private Sub AddButton_Click()
    MoveSelectedItems AvailableListBox, SelectedListBox
End Sub

Private Sub AvailableListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    MoveSelectedItems AvailableListBox, SelectedListBox
End Sub

Private Sub RemoveButton_Click()
    MoveSelectedItems SelectedListBox, AvailableListBox
End Sub

Private Sub SelectedListBox_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    MoveSelectedItems SelectedListBox, AvailableListBox
End Sub

Private Sub AddAllButton_Click()
    MoveSelectedItems AvailableListBox, SelectedListBox, True
End Sub

Private Sub RemoveAllButton_Click()
    MoveSelectedItems SelectedListBox, AvailableListBox, True
End Sub

Private Sub OKButton_Click()
    OKClicked = True
    Me.Hide
End Sub

Private Sub CancelButton_Click()
    Me.Hide
End Sub

Private Sub MoveSelectedItems(from_list As MSForms.ListBox, to_list As MSForms.ListBox, Optional target_all As Boolean = False)
    Dim i As Long
    For i = from_list.ListCount - 1 To 0 Step -1
        If from_list.Selected(i) Or target_all Then
            Dim j As Long
            For j = 0 To to_list.ListCount - 1
                If to_list.List(j) >= from_list.List(i) Then
                    Exit For
                End If
            Next
            to_list.AddItem from_list.List(i), j
            from_list.RemoveItem i
        End If
    Next
End Sub

標準モジュールのコード

DualListBoxの選択結果をイミディエイトウインドウに出力するコードを書いてみた。
フォームモジュールのOpenForm関数にString型データの入ったコレクションを渡すとAvailableListに表示され、フォームを閉じるとSelectedListの内容がコレクションで返る仕組み。

Sub hoge()
    Dim c As Collection: Set c = New Collection
    For i = Asc("A") To Asc("E")
        c.Add Chr(i)
    Next

    'フォームを開き、操作結果を取得
    Set c = DualListBoxForm.OpenForm(c)
    
    If Not c Is Nothing Then
        For Each s In c
            Debug.Print s
        Next
    End If
End Sub