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 SubRem ----------------------------------------------------------------------------------
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 SubRem ----------------------------------------------------------------------------------
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
削除ボタンも考え方は同じになります。


コメント