リストの絞り込み の続き④ ～ 各棚の本をリスト表示 ～

昨日は、題名が重複していても、別の本として認識できるようにしました。

infoment.hatenablog.com

今日は、「どの棚にどの本があるか」の情報も見える化してみましょう。
具体的には、以下の通りにします。

1. 本棚を示すセル選択 ⇒ セルの色と文字色を変更
2. 同セルで右クリック ⇒ ユーザーフォームが起動
3. ユーザーフォームに、選択した本棚用のリストボックスを追加

色を変える動作が複数回登場しますので、まずはこの機能をユーザー定義関数にして標準モジュールに追加します。

Public Function ChangeColor(target_sheet As Worksheet, _
                            target_range As Range) _
                            As Boolean
    On Error GoTo er:
    ' シートの色をリセット
    target_sheet.UsedRange.Interior.Color = xlNone
    target_sheet.UsedRange.Font.Color = vbBlack

    ' 指定セルの色を変更
    With target_range
        .Select
        .Interior.Color = 192
        .Font.Color = vbYellow
    End With
    ChangeColor = True
    Exit Function
er:
    ChangeColor = False
End Function

選択した色の変更については、「レイアウト図」シートのSelectionChangeイベントで対応します。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim myReg As RegExp
        Set myReg = New RegExp
        myReg.Pattern = "[1-9]{1}-[A-Z]{1}"
        
        If myReg.test(StrConv(Target.Value, vbNarrow)) = True Then
            ChangeColor ActiveSheet, Target
        End If
End Sub

選択したセルが本棚の時だけ色を変えたいので、今回は正規表現を用いてセル内の文字パターンを認識しています。本棚以外を意味する同パターンの表記が登場した場合は、追加で何か検討しなければならないのですが、今回は簡単にこの程度で済ませています。

ユーザーフォームの表示については、「レイアウト図」シートのBeforeRightClickイベントで対応します。

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Dim myReg As RegExp
        Set myReg = New RegExp
        myReg.Pattern = "[1-9]{1}-[A-Z]{1}"
        
        If myReg.test(StrConv(Target.Value, vbNarrow)) = True Then
            BookShelfForm.Show vbModeless
            Cancel = True
        End If
End Sub

色を変えるときとほぼ同じです。BookShlfFormを呼出す際、別の本棚を選択したくなることを考慮して、vbModelessで表示させています。これにより、ユーザーフォームが表示された状態で、シートの操作が可能になります。

次に、ユーザーフォーム側のレイアウト変更です。今回は、こんな風にしてみました。

通常、本棚にはたくさんの本が所蔵されているものなので、検索用のリストボックスより大きめにしました。今までの変更に伴い、ユーザーフォーム側のコードは次のように変更しました。

Option Explicit

Dim Book As BookShelfClass

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)
    On Error Resume Next
    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

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()
    Dim tempSeq As Variant
        Call BookShelfInformation
        ReDim tempSeq(1 To Books.Count, 1 To 2)
    Dim i As Long
        i = 1
        For Each Book In Books
            If Selection.Value = Book.本棚番号 Then
                tempSeq(i, 1) = Book.書籍名称
                tempSeq(i, 2) = Book.通し番号
                i = i + 1
            End If
        Next
    Dim seq As Variant
        ReDim seq(1 To i - 1, 1 To 2)
        seq = tempSeq
        ListBox2.List = seq
End Sub

Private Sub CloseButton_Click()
    Unload Me
End Sub

これで、指定した本棚のみに含まれる本が、リストボックスに表示されるようになりました。

次回に続く。

参考まで。