エクセル多用途もくじシートを自動作成するVBA

Option Explicit

'解説1
Function Flag() As Boolean
    Dim ws As Worksheet
        For Each ws In ThisWorkbook.Worksheets
            If ws.Name = "もくじシート" Then
                Flag = True
                Exit For
            Else
                Flag = False
            End If
        Next
End Function

'解説2
Sub シート一覧()
    Dim s, i, BorRow As Long
    Dim mySheetName() As String
'解説2-1
        If Flag = False Then
            On Error Resume Next
            Application.VBE.Windows(1).SetFocus
            With ThisWorkbook
                .Worksheets.Add(before:=Worksheets(1)).Name _
                            = "もくじシート"
                .VBProject.VBComponents(Worksheets("もくじシート").CodeName) _
                            .Name = "もくじシート"
            End With
            Application.VBE.MainWindow.Visible = False
'解説2-2
            If Err.Number = 9 Then
                Application.DisplayAlerts = False
                Worksheets("もくじシート").Delete
                Application.DisplayAlerts = True
                On Error GoTo 0
                MsgBox "起動エラーが発生しました。"
                Exit Sub
            End If
            Call Module1.UFリカバーCore
        End If
'解説2-3
        Worksheets("もくじシート").Select
        With Worksheets("もくじシート")
            With .Cells
                .Clear
                .Font.Bold = True
                .Font.Size = 13
            End With
            .Columns(1).HorizontalAlignment = xlCenter
            .Range("A2") = "NO."
            .Range("B2") = "シート名称"
            .Range("A1") = "シートもくじからそのシートにジャンプできます。"
            With .Range("A1:B2")
                .Font.ColorIndex = 5
                .Font.Size = 15
            End With
        ReDim mySheetName(1 To Worksheets.Count)      '
            For i = 1 To Worksheets.Count
                mySheetName(i) = Worksheets(i).Name
                .Range("A" & i + 2) = i
                .Range("B" & i + 2) = mySheetName(i)
            Next i
            With .Cells(1, 1).CurrentRegion
                BorRow = .Rows(.Rows.Count).Row
                .Offset(1).Resize(BorRow - 1, 2).Borders.LineStyle = True
                .Columns(2).AutoFit
            End With
            With .Range("A1")
                .HorizontalAlignment = xlLeft
                .Select
            End With
        End With
End Sub

'解説3
Sub シートジャンプ()
    Dim shRow As Long
    Dim SV As String
    Dim ws As Worksheet
    Dim Flagn As Boolean
        If Flag = False Then
            MsgBox "もくじシートがまだ作成されていません。"
            Exit Sub
        End If
            Worksheets("もくじシート").Select
            shRow = Cells(Rows.Count, 2).End(xlUp).Row
            If ActiveCell.Row < shRow + 1 And ActiveCell.Column = 2 Then
                SV = ActiveCell.Value
                If SV = "もくじシート" Then
                    Exit Sub
                Else
                    For Each ws In Worksheets
                        If ws.Name = SV Then Flagn = True
                    Next ws
                    If Flagn = True Then
                        Worksheets(SV).Select
                        Range("A1").Select
                    Else
                        MsgBox SV & "　シートは存在しません。", _
                                    vbInformation, "メッセージ"
                    End If
                End If
            End If
End Sub

'解説4
Sub シートを削除()
    Dim ActSh As String
    Dim Ans As Long
    Dim DelRow, n As Long
        If Flag = False Then
            MsgBox "もくじシートがまだ作成されていません。"
            Exit Sub
        End If
        ActSh = ActiveSheet.Name
        Ans = MsgBox("削除しようとしているシートは、「 " _
            & ActSh & " 」です。" & vbCrLf & "削除しますか？", _
            vbYesNo + vbExclamation, "削除許可申請")
        If Ans = vbNo Then
            Exit Sub
        ElseIf Ans = vbYes Then
            If ActSh = "もくじシート" Then
                MsgBox "もくじシートは削除出来ません。"
            Else
                Worksheets(ActSh).Delete
                Worksheets("もくじシート").Select
                With Cells(1, 1).CurrentRegion
                    DelRow = .Rows(.Rows.Count).Row
                End With
                For n = 3 To DelRow
                    If Cells(n, 2) = ActSh Then
                        Cells(n, 2).ClearContents
                    End If
                Next n
            End If
        End If
End Sub

'解説5

Sub UFリカバーCore()
    Dim wb As Workbook
    Set wb = ThisWorkbook
    With wb.VBProject.VBComponents
        .Item("もくじシート").CodeModule.AddFromString _
            "Private Sub Worksheet_Activate()" & vbCrLf & _
            "   If 目次コントロール.Visible = False Then" & vbCrLf & _
            "       目次コントロール.Show vbModeless" & vbCrLf & _
            "   End If" & vbCrLf & _
            "End Sub"
    End With
End Sub

Option Explicit


'解説５
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    If CloseMode = vbFormControlMenu Then
        MsgBox "機能の性質上このボタンでは終了出来ません。"
        Cancel = True
    End If
End Sub

Private Sub シート削除_Click()
Call Module1.シートを削除
End Sub

Private Sub シート表示_Click()
Call Module1.シートジャンプ
End Sub

Private Sub もくじシート更新_Click()
Call Module1.シート一覧
End Sub

Option Explicit

Private Sub Workbook_Open()
    目次コントロール.Show vbModeless
End Sub

Option Explicit

Private Sub Worksheet_Activate()
   If 目次コントロール.Visible = False Then
       目次コントロール.Show vbModeless
   End If
End Sub