リストの絞り込み　の続き② ～選択した資料の所在を見える化～

昨日は、絞り込んで選択した本の詳細情報を表示させました。
infoment.hatenablog.com

今回はさらに、「選択した本がどこにあるか？」を見える化してみます。

まず、書籍テーブルを含むシートを「書籍データ」と名付けます。
f:id:Infoment:20180814201311p:plain

次に、部屋の簡易見取図として「レイアウト図」シートを作成します。
f:id:Infoment:20180814201556p:plain

「１－Ａ」～「１－Ｃ」の各セルが、各本棚を表しています。

それでは、コードの一部を変更するために、標準モジュール内のコードを以下に置き換えます。

Sub BookShelfInformation()
    Dim Tb As ListObject
        Set Tb = Sheets("書籍データ").ListObjects("書籍テーブル") ' ・・・変更箇所
        Set Books = New Collection
    
    Dim i As Long
    For i = 1 To Tb.DataBodyRange.Rows.Count
        With New BookShelfClass
            .本棚番号 = Tb.DataBodyRange.Cells(i, 本棚番号)
            .書籍名称 = Tb.DataBodyRange.Cells(i, 書籍名称)
            .著者氏名 = Tb.DataBodyRange.Cells(i, 著者氏名)
            
            Books.Add .Self
        End With
    Next
End Sub

昨日はシートの指定を ActiveSheet としていましたが、今回はレイアウト図のシートがアクティブな状態での処理となるため、書籍テーブルの所在シートを明示する必要があったわけです。

最後に、ユーザーフォーム内のコードのうち ListBox1_MouseUp を以下の内容に置き換えます。

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) Then
            本棚番号Label = Book.本棚番号
            書籍名称Label = Book.書籍名称
            著者氏名Label = Book.著者氏名
            
            Dim Sh As Worksheet
                Set Sh = Sheets("レイアウト図")
                Sh.UsedRange.Interior.Color = xlNone
                Sh.UsedRange.Font.Color = vbBlack
            
            Dim FoundCell As Range
                Set FoundCell = Sh.Cells.Find(What:=Book.本棚番号, LookAt:=xlWhole)
                If Not FoundCell Is Nothing Then
                    FoundCell.Select
                    FoundCell.Interior.Color = 192
                    FoundCell.Font.Color = vbYellow
                End If
            Exit Sub
        End If
    Next
End Sub