【Access】(VBA)リストボックスを複数選択(修正版)

Accessのリストボックスを複数選択する方法をご紹介します。

※5/13 subSetMoveSkill関数に誤りがありましたので修正しました

前回の続きです。

リストボックスを複数選択すると、前回ご紹介した追加ボタンの方法だと上手く動作しなくなるので
追加ボタンのVBAも修正して複数選択対応版にしてみたいと思います。

プロパティの変更

リストボックスコントロールを右クリックして、プロパティを表示します。
プロパティのその他タブにある複数選択の値は、
初期値が「しない」になっているのでそれを標準か拡張に変更します。

プロパティ＞その他＞複数選択
・しない
・標準
・拡張

VBA関数の修正

前回ご紹介した「subSetMoveSkill()」関数を修正しました。

Rem ----------------------------------------------------------------------------------
Rem     関数名   : subSetMoveSkill
Rem     処理内容 : リストで選択された項目をもう1つのリストへコピーし削除する。
Rem     引  数　 : pMotoControlNm；移動元コントロール名、pSakiControlNm：移動先コントロール名
Rem     戻り値　 : なし
Rem ----------------------------------------------------------------------------------
Private Sub subSetMoveSkill(pMotoControlNm As String, pSakiControlNm As String)
Dim varData     As Variant
Dim lngDelIdx() As Long    ' 削除インデックス
Dim j As Integer

On Error GoTo Error

    ' 選択された項目を右にコピー
    For Each varData In Controls(pMotoControlNm).ItemsSelected
        Controls(pSakiControlNm).AddItem Controls(pMotoControlNm).ItemData(varData)
    Next
    
'    ' 選択された項目を削除→全部削除されてしまうので×
'    For i = Controls(pMotoControlNm).ListCount To 1 Step -1
'        Controls(pMotoControlNm).RemoveItem i - 1
'    Next
    
    ' 選択されている項目Noを取得
    j = 0
    For i = 0 To Controls(pMotoControlNm).ListCount
        If Controls(pMotoControlNm).Selected(i) Then
            ReDim Preserve lngDelIdx(j)
            lngDelIdx(j) = i
            j = j + 1
        End If
    Next
    
    ' 選択された項目を削除
    For i = j - 1 To 0 Step -1
        Controls(pMotoControlNm).RemoveItem lngDelIdx(i)
    Next

    ' スキル要約に反映
    Call subSetSkillYoyak
    
Exit Sub
Error:
    MsgBox "エラーが発生しました。エラー内容：" & Err.Description & Chr$(10), vbCritical, frmNm & "関数：subSetMoveSkill"
End Sub

修正ポイント1

選択された項目を右に移動するのと、選択された項目を削除する処理を別々にしました。

こちらは選択された項目を右のリストボックスにコピーしています

    
    ' 選択された項目を右にコピー
    For Each varData In Controls(pMotoControlNm).ItemsSelected
        Controls(pSakiControlNm).AddItem Controls(pMotoControlNm).ItemData(varData)
    Next

修正ポイント2

    
    ' 選択された項目を削除
'    For i = Controls(pMotoControlNm).ListCount To 1 Step -1
'        Controls(pMotoControlNm).RemoveItem i - 1
'    Next

    
    ' 選択されている項目Noを取得
    j = 0
    For i = 0 To Controls(pMotoControlNm).ListCount
        If Controls(pMotoControlNm).Selected(i) Then
            ReDim Preserve lngDelIdx(j)
            lngDelIdx(j) = i
            j = j + 1
        End If
    Next
    
    ' 選択された項目を削除
    For i = j - 1 To 0 Step -1
        Controls(pMotoControlNm).RemoveItem lngDelIdx(i)
    Next

最初に選択されている項目Noを取得し変数に格納しておきます。
その後、後ろのコントロールから削除していきます。