Microsoft Access リストボックス処理のメモ

普段はなかなか使いませんが、久々に使うことになってあれこれやったときのメモ。

今回作ったのは、よくある
「左側のリスト要素を選択して右側のリストに入れたり、右側のリストから戻したり」
という例のやつ。

---

1. 前提

AccessのリストボックスをVBAで制御するには、まず双方のリストボックスの
「値集合タイププロパティ：値リスト」
である必要があります。

---

2. ベタな例

かなりベタな例ですが、それぞれのリストボックスから項目を移動させる「→」「←」ボタンのクリックイベントは、それぞれ次のように指定します。

「→」ボタンClickedイベント

    With Me![左側リスト]
        If .ItemsSelected.Count < 1 Then
            .SetFocus
            MsgBox "左側リストの項目を選択してください。", vbExclamation
            Exit Sub
        End If
        Dim 選択項目 As Variant
        For Each 選択項目 In .ItemsSelected      ' 右側リストに追加＆左側リストから削除
            Me![右側リスト].AddItem .ItemData(選択項目)
            .RemoveItem .ItemData(選択項目)
        Next 選択項目
    End With

「←」ボタンClickedイベント

     With Me![右側リスト]
        If .ItemsSelected.Count < 1 Then
            .SetFocus
            MsgBox "右側リストの項目を選択してください。", vbExclamation
            Exit Sub
        End If
        
        Dim 選択項目 As Variant, To項目() As Variant, i As Long
        i = 0
        ReDim To項目(.ItemsSelected.Count - 1)
        For Each 選択項目 In .ItemsSelected     ' 右側リストの選択項目を対比
            To項目(i) = .ItemData(選択項目)
            i = i + 1
        Next 選択項目
    End With
        
    For i = 0 To UBound(To項目)                 ' 左側リストに追加＆右側リストから削除
        Me![左側リスト].AddItem To項目(i)
        Me![右側リスト].RemoveItem To項目(i)
    Next i

---

3. やがて・・・

意図した機能は実現できたんですが・・・
あれこれやってるうち、順番ぐちゃぐちゃで汚くなりました

せめて左側のリストくらいは、同じ並び順を保ちたいもんです。

---

4. 実は

意外とネットのコンテンツなどでは触れられてないんですが、AddItem/RemoveItemなどでリストの項目を追加・削除すると、その時点で該当リストのRowSourceプロパティが動的に変わります。

これを利用して、次のように工夫してみました。
(1)フォームオープン時に左側リストの項目を設定
　⇒この時のRowSourceの内容をフォームグローバルな変数に退避
(2)→ボタン／←ボタンクリック時は、まず右側リストの項目追加・削除だけを制御。
　その後、(1)で保存した内容を右側リストの値で消去していき、残った内容を左側リストのRowSourceに設定する。

左側リストを編集する共通プロシジャー

    Private vPr_リストデータ As Variant     ' フォームオープン時の左側リストの初期値を格納
Private Sub sPr_左側リスト組み立て()

     Dim i As Long, j As Long
     Dim リスト要素 As String
     リスト要素 = ""
     For i = 0 To UBound(vPr_リストデータ)
        For j = 0 To Me![右側リスト].ListCount - 1
            If vPr_リストデータ(i) = Me![右側リスト].ItemData(j) Then
                Exit For
            End If
        Next j
        If j > Me![右側リスト].ListCount - 1 Then       ' 右側リストにない項目をセミコロンで連結
            リスト要素 = リスト要素 & vPr_リストデータ(i) & ";"
        End If
    Next i
    ' ***** ※RowSourceを一括して入れ替えるとフォームのちらつきが少なくなります
    Me![左側リスト].RowSource = Left$(リスト要素, Len(リスト要素) - 1)

End Sub

フォームOpenイベント

Private Sub Form_Open(Cancel As Integer)

    ' 左側リストへのデータ追加
    Me![左側リスト].AddItem "項目01"
    ・・・
    Me![左側リスト].AddItem "項目08"
    
    vPr_リストデータ = Split(Me![左側リスト].RowSource, ";")        ' 左側リストの初期値を配列で格納

End Sub

「→」ボタンClickイベント

    With Me![左側リスト]
        If .ItemsSelected.Count < 1 Then
            .SetFocus
            MsgBox "左側リストを選択してください。", vbExclamation
            Exit Sub
        End If
        Dim 選択項目 As Variant
        For Each 選択項目 In .ItemsSelected                 ' 左側リストの選択項目を右側リストに追加
            Me![右側リスト].AddItem .ItemData(選択項目)
        Next 選択項目
    End With
    
    Call sPr_左側リスト組み立て                             ' 左側リストの更新

「←」ボタンClickイベント

    With Me![右側リスト]
        If .ItemsSelected.Count < 1 Then
            .SetFocus
            MsgBox "右側リストを選択して下さい。", vbExclamation
            Exit Sub
        End If
        
        Dim 選択項目 As Variant, 右側リスト項目() As Variant, i As Long
        i = 0
        ReDim 右側リスト項目(.ItemsSelected.Count - 1)
        For Each 選択項目 In .ItemsSelected
            右側リスト項目(i) = .ItemData(選択項目)
            i = i + 1
        Next 選択項目
    End With
    
    For i = 0 To UBound(右側リスト項目)                     ' 右側リストの選択項目を削除
        Me![右側リスト].RemoveItem 右側リスト項目(i)
    Next i
    Call sPr_左側リスト組み立て                             ' 左側リストの更新

これで、左側リストの順序は常に保たれます

---

5. おまけ

同一リストボックス内で選択項目の順序を入れ替えるコーディングはこちら。
複数行選択して動かす方法は、現在思案中です・・・

「↑」ボタンClickイベント

    With Me![右側リスト]
        .SetFocus       ' フォーカスを当てないと下のListIndex更新で7777エラーとなる
        
        Dim インデックス As Long, 項目内容 As String
        インデックス = .ListIndex
        If インデックス = 0 Then Exit Sub
        
        項目内容 = .ItemData(インデックス)
        .RemoveItem インデックス
        .AddItem 項目内容, インデックス - 1
        .ListIndex = インデックス - 1
    End With

「↓」ボタンClickイベント

    With Me![右側リスト]
        .SetFocus       ' フォーカスを当てないと下のListIndex更新で7777エラーとなる
        
        Dim インデックス As Long, 項目内容 As String
        インデックス = .ListIndex
        If インデックス = .ListCount - 1 Then Exit Sub
        
        項目内容 = .ItemData(インデックス)
        .RemoveItem インデックス
        .AddItem 項目内容, インデックス + 1
        .ListIndex = インデックス + 1
    End With