前提・実現したいこと
お世話になります。
Excel VBAにてユーザーフォームを作製しているのですが、タイトルの通り、親フォームのボタン(btnInd)から子フォーム(frmIndAll)を呼び出し、親フォーム内にある値を子フォームのラベルに渡そうとしています。
渡すことはできるのですが、子フォームが開いたときにリストボックスが更新されなくて困っています。
「試したコード」のように、子フォームのinitializeに条件を書いてしまえば一応思った通りにはなるのですが、呼び出し元のフォームがほかにもいくつかあるため、できればinitializeには書きたくはありません。(書いても何とかなる方法もあるのでしょうか…?)
この原因、対処法を教えていただきたいです。
発生している問題・エラーメッセージ
エラーメッセージは出ていません。
親フォームのボタンのコード
Excel
1Private Sub btnInd_Click() 2 With frmCRecordSearch.lstRecord 3 Dim targetRow As Integer 4 targetRow = .ListIndex 5 frmIndAll.lblNen.Caption = .List(targetRow, 1) 6 frmIndAll.lblKumi.Caption = .List(targetRow, 2) 7 frmIndAll.lblNum.Caption = .List(targetRow, 3) 8 frmIndAll.lblSex.Caption = .List(targetRow, 4) 9 frmIndAll.lblName.Caption = .List(targetRow, 5) 10 frmIndAll.lblRemark = .List(targetRow, 9) 11 End With 12 frmIndAll.Show 13End Sub
呼び出されるフォーム(frmIndAll)のinitializeコード
Excel
1Private Sub UserForm_Initialize() 2 Dim t As String 3 t = "記録検索" 4 '記録日付の新しい順にソートして抽出 5 Worksheets("記録検索").Activate 6 Range("B2:M2").Clear 7 Range("O2").Clear 8 Range("H2").Value = frmIndAll.lblName.Caption 9 '抽出 10 Sheets("ポートフォリオ").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ 11 CriteriaRange:=Range("A1:O2"), CopyToRange:=Range("A10:N10"), Unique:=True 12 '抽出結果をソート 13 SortChildI "A10" 14 15 '「記録一覧」リストボックスの設定 16 With lstIndRecord 17 .Clear 'リストボックス内のクリア 18 .ColumnCount = 10 19 .ColumnWidths = "70;20;20;20;20;60;60;60;100;0" 20 .TextAlign = fmTextAlignLeft 21 .Font.Size = 10 22 Dim startRow As Integer 23 Dim LastRow As Integer 24 startRow = 11 25 LastRow = Worksheets(t).Range("A65536").End(xlUp).Row 26 Dim i As Integer 27 For i = startRow To LastRow 28 .AddItem Cells(i, 3) '日付 29 .List(.ListCount - 1, 1) = Cells(i, 4).Value '年 30 .List(.ListCount - 1, 2) = Cells(i, 5).Value '組 31 .List(.ListCount - 1, 3) = Cells(i, 6).Value '出席番号 32 .List(.ListCount - 1, 4) = Cells(i, 7).Value '性別 33 .List(.ListCount - 1, 5) = Cells(i, 8).Value '氏名 34 .List(.ListCount - 1, 6) = Cells(i, 10).Value 'カテゴリ 35 .List(.ListCount - 1, 7) = Cells(i, 11).Value '詳細カテゴリ 36 .List(.ListCount - 1, 8) = Cells(i, 12).Value '記録内容 37 .List(.ListCount - 1, 9) = Cells(i, 13).Value '備考 38 Next 39 End With 40End Sub
試したコード(うまくいくがこれでは困ってしまいます)
Excel
1Private Sub UserForm_Initialize() 2 Dim t As String 3 t = "記録検索" 4 With frmCRecordSearch.lstRecord 5 Dim targetRow As Integer 6 targetRow = .ListIndex 7 Me.lblNen.Caption = .List(targetRow, 1) 8 Me.lblKumi.Caption = .List(targetRow, 2) 9 Me.lblNum.Caption = .List(targetRow, 3) 10 Me.lblSex.Caption = .List(targetRow, 4) 11 Me.lblName.Caption = .List(targetRow, 5) 12 Me.lblRemark = .List(targetRow, 9) 13 End With 14 '記録日付の新しい順にソートして抽出 15 Worksheets("記録検索").Activate 16 Range("B2:M2").Clear 17 Range("O2").Clear 18 Range("H2").Value = frmIndAll.lblName.Caption 19 '抽出 20 Sheets("ポートフォリオ").Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _ 21 CriteriaRange:=Range("A1:O2"), CopyToRange:=Range("A10:N10"), Unique:=True 22 '抽出結果をソート 23 SortChildI "A10" 24 25 '「記録一覧」リストボックスの設定 26 With lstIndRecord 27 .Clear 'リストボックス内のクリア 28 .ColumnCount = 10 29 .ColumnWidths = "70;20;20;20;20;60;60;60;100;0" 30 .TextAlign = fmTextAlignLeft 31 .Font.Size = 10 32 Dim startRow As Integer 33 Dim LastRow As Integer 34 startRow = 11 35 LastRow = Worksheets(t).Range("A65536").End(xlUp).Row 36 Dim i As Integer 37 For i = startRow To LastRow 38 .AddItem Cells(i, 3) '日付 39 .List(.ListCount - 1, 1) = Cells(i, 4).Value '年 40 .List(.ListCount - 1, 2) = Cells(i, 5).Value '組 41 .List(.ListCount - 1, 3) = Cells(i, 6).Value '出席番号 42 .List(.ListCount - 1, 4) = Cells(i, 7).Value '性別 43 .List(.ListCount - 1, 5) = Cells(i, 8).Value '氏名 44 .List(.ListCount - 1, 6) = Cells(i, 10).Value 'カテゴリ 45 .List(.ListCount - 1, 7) = Cells(i, 11).Value '詳細カテゴリ 46 .List(.ListCount - 1, 8) = Cells(i, 12).Value '記録内容 47 .List(.ListCount - 1, 9) = Cells(i, 13).Value '備考 48 Next 49 End With 50End Sub
回答1件
あなたの回答
tips
プレビュー
バッドをするには、ログインかつ
こちらの条件を満たす必要があります。
2019/03/04 15:27