【Access】(VBA)リストボックスで選択した値を他のリストボックスに移動する

スポンサーリンク

Accessのフォームにリストボックスを作成し、
左から右に移動し移動したら左の選択項目は削除するVBAをご紹介します。
必要なのは、リストボックス2つと追加ボタンと削除ボタンです。

左のリストボックス
名前:lstSkill_1

右のリストボックス
名前:lstSkill_in_1

追加ボタン
名前:cmdLstSkillAdd_1

(1)初期表示

左のリストボックスに値集合ソースでデータセット

m_skillマスタテーブルを用意しておき、そこからスキル名を取得して
起動時に値をセットしています。

(2)追加ボタンを押下

追加ボタンを押下すると右のリストボックスに選択された値が移動します。

追加ボタンクリック時イベント

Private Sub cmdLstSkillAdd_1_Click()
    Call subSetMoveSkill("lstSkill_1", "lstSkill_in_1")
End Sub
Rem ----------------------------------------------------------------------------------
Rem     関数名   : subSetMoveSkill
Rem     処理内容 : リストで選択された項目をもう1つのリストへコピーし削除する。
Rem     引  数  : pMotoControlNm;移動元コントロール名、pSakiControlNm:移動先コントロール名
Rem     戻り値  : なし
Rem ----------------------------------------------------------------------------------
Private Sub subSetMoveSkill(pMotoControlNm As String, pSakiControlNm As String)
Dim varData     As Variant

On Error GoTo Error

    For Each varData In Controls(pMotoControlNm).ItemsSelected
        Controls(pSakiControlNm).AddItem Controls(pMotoControlNm).ItemData(varData)
        Controls(pMotoControlNm).RemoveItem (varData)
    Next
    
    ' スキル要約に反映
    Call subSetSkillYoyak
    
Exit Sub
Error:
    MsgBox "エラーが発生しました。エラー内容:" & Err.Description & Chr$(10), vbCritical, frmNm & "関数:subSetMoveSkill"
End Sub
Rem ----------------------------------------------------------------------------------
Rem     関数名   : subSetSkillYoyak
Rem     処理内容 : 選択されたリスト内容をスキル要約テキストにコピーする。
Rem     引  数  : なし
Rem     戻り値  : なし
Rem ----------------------------------------------------------------------------------
Private Sub subSetSkillYoyak()
Dim i As Integer
Dim cnt As Integer
Dim strSelected As String
Dim strControlsNm As String
Dim strControlsSakiNm As String

On Error GoTo Error

    strSelected = vbNullString
    Me.txtスキル要約.Value = ""

    For cnt = 1 To 3
        strControlsNm = "lstSkill_in_" & Trim(CStr(cnt))
        For i = 0 To Controls(strControlsNm).ListCount - 1
            If strSelected = vbNullString Then
                strSelected = Controls(strControlsNm).ItemData(i) & ""
            Else
                strSelected = strSelected & ", " & Controls(strControlsNm).ItemData(i) & ""
            End If
        Next
    Next

    Me.txtスキル要約.Value = strSelected

Exit Sub
Error:
    MsgBox "エラーが発生しました。エラー内容:" & Err.Description & Chr$(10), vbCritical, frmNm & "関数:subSetSkillYoyak"
End Sub

削除ボタンも考え方は同じになります。

コメント

タイトルとURLをコピーしました