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