前提・実現したいこと
VBAで入力情報の修正フォームを書いています。
フォーム上の値を修正したのち、実行すると、
'メイン処理
With ListBox1
Dim TargetIndex As Integer
TargetIndex = .ListIndex
のあたりで、
Private Sub ListBox1_Change()のところに戻ってしまい、リストボックス内の値が変わることなく、修正前の状態のままになってしまいます
Changeに戻らないようにするにはどうすればよいでしょうか。
Application.EnableEventではやはり解決できませんでした。
対策あれば教えていただきたいです。
よろしくお願いいたします。
※追記
2番目のソースコードを参考に今回のコードを書いたのですが、そちらではChangeイベントが発生しないまま進みます。
何の違いがあってこのようなことが起こるのか、教えていただきたいです。
よろしくお願いいたします。
該当のソースコード
Excel
1Option Explicit 2 3Private Sub UserForm_Initialize() 4 Worksheets("マスタ").Select 5 6 'リストボックスの設定 7 With ListBox1 8 .Font.Size = 10 9 .ColumnCount = 8 10 .ColumnWidths = "0;30;30;30;100;100;120" 11 .TextAlign = fmTextAlignLeft 12 .Font.Name = "MS ゴシック" 13 14 '「マスタ」シートのセルの内容をリストボックスに転記 15 Dim i As Integer 16 Dim LastRow As Integer 17 LastRow = Range("A65536").End(xlUp).Row 18 For i = 2 To LastRow 19 .AddItem Cells(i, 1).Value 20 .List(.ListCount - 1, 1) = Cells(i, 2).Value 21 .List(.ListCount - 1, 2) = Cells(i, 3).Value 22 .List(.ListCount - 1, 3) = Cells(i, 4).Value 23 .List(.ListCount - 1, 4) = Cells(i, 5).Value 24 .List(.ListCount - 1, 5) = Cells(i, 6).Value 25 .List(.ListCount - 1, 6) = Cells(i, 7).Value 26 .List(.ListCount - 1, 7) = Cells(i, 8).Value 27 Next 28 End With 29 30 'IDを変更不可能にする 31 txtID.Locked = True 32End Sub 33 34Private Sub ListBox1_Change() 35 With ListBox1 36 Dim targetRow As Integer 37 targetRow = .ListIndex 38 39 txtID.Text = .List(targetRow, 0) 40 txtName.Text = .List(targetRow, 5) 41 txtFurigana.Text = .List(targetRow, 6) 42 cmbNen.Text = .List(targetRow, 1) 43 cmbKumi.Text = .List(targetRow, 2) 44 txtNum.Text = .List(targetRow, 3) 45 cmbSex.Text = .List(targetRow, 4) 46 txtRemark.Text = .List(targetRow, 7) 47 End With 48End Sub 49 50Private Sub btnCUpdate_Click() 51 '「基本情報」を修正する 52 Dim msg As String, title As String 53 msg = "修正します。よろしいですか?" 54 title = "修正の確認" 55 56 Dim res As Integer 57 res = MsgBox(msg, vbYesNo + vbInformation, title) 58 If res = vbNo Then Exit Sub 59 60 'メイン処理 61 With ListBox1 62 Dim TargetIndex As Integer 63 TargetIndex = .ListIndex 64 .List(TargetIndex, 1) = cmbNen.Text 65 .List(TargetIndex, 2) = cmbKumi.Text 66 .List(TargetIndex, 3) = txtNum.Text 67 .List(TargetIndex, 4) = cmbSex.Text 68 .List(TargetIndex, 5) = txtName.Text 69 .List(TargetIndex, 6) = txtFurigana.Text 70 .List(TargetIndex, 7) = txtRemark.Text 71 End With 72 73 'シートのデータを変更 74 Dim tRow As Integer 75 tRow = CInt(txtID.Text) + 1 76 Cells(tRow, 2).Value = cmbNen.Text 77 Cells(tRow, 3).Value = cmbKumi.Text 78 Cells(tRow, 4).Value = txtNum.Text 79 Cells(tRow, 5).Value = cmbSex.Text 80 Cells(tRow, 6).Value = txtName.Text 81 Cells(tRow, 7).Value = txtFurigana.Text 82 Cells(tRow, 8).Value = txtRemark.Text 83 84 '各コントロールのクリア 85 cmbNen.Text = "" 86 cmbKumi.Text = "" 87 txtNum.Text = "" 88 cmbSex.Text = "" 89 txtName.Text = "" 90 txtFurigana.Text = "" 91 txtRemark.Text = "" 92End Sub 93 94Private Sub btnClose_Click() 95 Unload Me 96End Sub
Changeイベントが発生せずに進むコード
Option Explicit Private Sub btnClose_Click() Unload Me End Sub Private Sub btnDelete_Click() Dim strMsg As String Dim strTitle As String Dim res As Integer 'MsgBoxの戻り値を格納 strMsg = ListBox1.List(ListBox1.ListIndex, 1) 'リストボックスで選択された値の2列目(第2引数「1」)の値を変数に格納 strMsg = strMsg & " を削除します。よろしいですか?" strTitle = "削除の確認" res = MsgBox(strMsg, vbYesNo + vbExclamation, strTitle) If res = vbNo Then Exit Sub '削除の処理 Dim TargetRow As Integer TargetRow = ListBox1.Value + 1 'Valueプロパティにはリストボックスの選択された行の1列目の値が格納されているので、ここでは商品IDが変数に格納される Cells(TargetRow, 8).Value = 1 'リストボックスの行を削除/更新 ListBox1.RemoveItem ListBox1.ListIndex '選択されている行番号(ListBox1.ListIndex)を引数に指定して削除 End Sub Private Sub btnUpdate_Click() Dim Msg As String, Title As String Msg = "修正します。よろしいですか?" Title = "修正の確認" Dim res As Integer res = MsgBox(Msg, vbYesNo + vbInformation, Title) If res = vbNo Then Exit Sub 'メイン処理(vbYes) With ListBox1 Dim TargetIndex As Integer TargetIndex = .ListIndex 'どの行が選択されているかを変数に格納 .List(TargetIndex, 1) = txtGoods.Text .List(TargetIndex, 2) = cboCategory.Value .List(TargetIndex, 3) = txtMaker.Text .List(TargetIndex, 4) = FormatAddSpace(Format(txtPrice.Text, "#,##0"), 10) .List(TargetIndex, 5) = txtUnit.Text .List(TargetIndex, 6) = txtRemark.Text End With 'シートのデータを更新 Dim TargetRow As Integer TargetRow = CInt(txtID.Text) + 1 Cells(TargetRow, 2).Value = txtGoods.Text Cells(TargetRow, 3).Value = cboCategory.Text Cells(TargetRow, 4).Value = txtMaker.Text Cells(TargetRow, 5).Value = txtPrice.Text Cells(TargetRow, 6).Value = txtUnit.Text Cells(TargetRow, 7).Value = txtRemark.Text '各コントロール値のクリア txtID.Text = "" txtGoods.Text = "" cboCategory.Text = "" txtMaker.Text = "" txtPrice.Text = "" txtUnit.Text = "" txtRemark.Text = "" End Sub Private Sub ListBox1_Change() With ListBox1 Dim TargetRow As Integer '現在選択されている項目を識別し、行番号を変数に格納 TargetRow = .ListIndex 'ListBox.Textには選択された行の値が格納されている(複数列の場合は1列目の値) txtID.Text = .Text txtGoods.Text = .List(TargetRow, 1) cboCategory.Text = .List(TargetRow, 2) txtMaker.Text = .List(TargetRow, 3) txtPrice.Text = Trim(.List(TargetRow, 4)) 'スペース削除 txtUnit.Text = .List(TargetRow, 5) txtRemark.Text = .List(TargetRow, 6) '修正ボタンと削除ボタンを有効にする btnUpdate.Enabled = True btnDelete.Enabled = True End With End Sub Private Sub UserForm_Initialize() '「商品マスタ」をフォームが表示されたときに選択する Worksheets("商品マスタ").Select 'リストボックスの設定 With ListBox1 .Font.Size = 10 .ColumnCount = 7 .ColumnWidths = "50;100;80;80;100;30;70" .TextAlign = fmTextAlignLeft .Font.Name = "MS ゴシック" 'リストボックスにデータを表示させる Dim i As Integer, LastRow As Integer LastRow = Range("A65536").End(xlUp).Row For i = 2 To LastRow If Cells(i, 8).Value <> 1 Then .AddItem FormatAddSpace(Cells(i, 1).Value, 4) .List(.ListCount - 1, 1) = Cells(i, 2).Value .List(.ListCount - 1, 2) = Cells(i, 3).Value .List(.ListCount - 1, 3) = Cells(i, 4).Value .List(.ListCount - 1, 4) = FormatAddSpace(Format(Cells(i, 5).Value, "#,##0"), 10) .List(.ListCount - 1, 5) = Cells(i, 6).Value .List(.ListCount - 1, 6) = Cells(i, 7).Value End If Next End With '商品IDを変更不可能にする txtID.Locked = True '修正ボタンと削除ボタンを無効にしておく btnUpdate.Enabled = False btnDelete.Enabled = False End Sub
回答3件
あなたの回答
tips
プレビュー