リストの絞り込み　の続き⑥ ～ いずれかのリストボックスがクリックされたことを検知する ～

Excel VBA クラスモジュール

昨日は、本棚を表すセルをクリックするたびに、リストボックスの内容が更新されるようにしました。

infoment.hatenablog.com

本日は機能拡張を一旦終え、今までに作ったコードのスリム化に挑戦です。
やはり一番気になるのは、ユーザーフォームのリストボックスに関する、この個所でしょうか。

Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    For Each Book In Books
        If Book.通し番号 = ListBox1.List(ListBox1.ListIndex, 1) Then
            本棚番号Label = Book.本棚番号
            書籍名称Label = Book.書籍名称
            著者氏名Label = Book.著者氏名
            
            Dim Sh As Worksheet
                Set Sh = Sheets("レイアウト図")
            
            Dim FoundCell As Range
                Set FoundCell = Sh.Cells.Find(What:=Book.本棚番号, LookAt:=xlWhole)
                If Not FoundCell Is Nothing Then
                    ChangeColor Sh, FoundCell
                End If
            Exit Sub
        End If
    Next
End Sub

Private Sub ListBox2_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    For Each Book In Books
        If Book.通し番号 = ListBox2.List(ListBox2.ListIndex, 1) Then
            本棚番号Label = Book.本棚番号
            書籍名称Label = Book.書籍名称
            著者氏名Label = Book.著者氏名
            
            Dim Sh As Worksheet
                Set Sh = Sheets("レイアウト図")
            
            Dim FoundCell As Range
                Set FoundCell = Sh.Cells.Find(What:=Book.本棚番号, LookAt:=xlWhole)
                If Not FoundCell Is Nothing Then
                    ChangeColor Sh, FoundCell
                End If
            Exit Sub
        End If
    Next
End Sub

リストボックス毎に、リストボックス名だけ違うコードが書かれています。
リストボックスが100個あれば、100回同じような記述が続きます。これは、果てしなく面倒臭い。修正が生じた場合、100か所の修正が必要になります。

そこで次の手順を導入することで、スリム化を図ります。

  1. とにかく、いずれかのリストボックスがクリックされたことを切っ掛けに発生するイベントを作る。
  2. イベントの中で、クリックされたリストボックスに合わせた処理を行う。

これであれば、リストボックスの数だけコードを複製する必要はありません。

それでは、まずクラスモジュールを一つ追加します。モジュール名は、ListBoxControlClassとします。内容は、下記のとおりです。

Option Explicit

Private WithEvents myListBox As MSForms.ListBox
Private myIndex As Long

Public Sub Set_ListBox(newListBox As MSForms.ListBox, Index As Long)
    Set myListBox = newListBox
    myIndex = Index
End Sub

Private Sub myListbox_Click()
    With BookShelfForm
        For Each Book In Books
            If Book.通し番号 = myListBox.List(myListBox.ListIndex, 1) Then
                .本棚番号Label = Book.本棚番号
                .書籍名称Label = Book.書籍名称
                .著者氏名Label = Book.著者氏名
    
                Dim Sh As Worksheet
                    Set Sh = Sheets("レイアウト図")
    
                Dim FoundCell As Range
                    Set FoundCell = Sh.Cells.Find(What:=Book.本棚番号, LookAt:=xlWhole)
                    If Not FoundCell Is Nothing Then
                        ChangeColor Sh, FoundCell
                    End If
                    
                    If myIndex = 2 Then
                        .TextBox1.Value = ""
                        .ListBox1.Clear
                    End If
                    
                Exit Sub
            End If
        Next
    End With
End Sub

リストボックスがクリックされたことを検知するために（WithEvents）、myListBoxを宣言しています。myIndexは、何番目のリストボックスかを知るためのものです。

Set_ListBoxで、検知したいリストボックスを登録しています。

myListBox_Clickで、リストボックスがクリックされた際の処理を一手に引き受けています。内容はユーザーフォームで繰り返し記述されていたものとほぼ同じです。

次に、標準モジュールに以下を追加します。

Public BookShelfListBox(1 To 2) As ListBoxControlClass

Sub SetBookShelfListBox()
    Dim i As Long
        For i = 1 To 2
            Set BookShelfListBox(i) = New ListBoxControlClass
            BookShelfListBox(i).Set_ListBox BookShelfForm.Controls("ListBox" & i), i
        Next
End Sub

これでリストボックスを一つずつ登録して、クリックを検知できるようにしていきます。リストボックスが100個あれば、1 To 2 を 1 To 100 にするだけでよく、コードの長さは殆ど変わりません。

最後に、ユーザーフォームのコードを変更します。

Option Explicit

Private Sub TextBox1_Change()
    Dim str  As String
        str = TextBox1.Value
        ListBox1.Clear
    Dim seq As Variant
    ReDim seq(1 To Books.Count, 1 To 2)
    Dim i As Long
        i = 1
        For Each Book In Books
            If Book.書籍名称 Like "*" & str & "*" Then
                seq(i, 1) = Book.書籍名称
                seq(i, 2) = Book.通し番号
                i = i + 1
            End If
        Next
        ListBox1.List = seq
End Sub

Private Sub UserForm_Initialize()
    Call InitUserform
    Call SetBookShelfListBox
End Sub

Private Sub CloseButton_Click()
    Unload Me
End Sub

リストボックスのクリックに関する部分が外に出たため、とてもスッキリしました。

次回に続く（かもしれない）。

参考まで。