【VBA】シート名取得＆非表示シート複数再表示

標準モジュール

Sub sheetList(ByVal control As IRibbonControl)
    UserForm1.Show vbModeless
End Sub

Function シート存在確認() As Boolean
    Dim ws As Worksheet
    Dim flag As Boolean
    
    For Each ws In Worksheets
        If ws.Name = "シート一覧" Then
            flag = True
        End If
    Next ws
    
    シート存在確認 = flag
End Function

Function シート削除()
    Dim flag As Boolean
    flag = シート存在確認
    
    If flag Then
        Application.DisplayAlerts = False
        Worksheets("シート一覧").Delete
        Application.DisplayAlerts = True
    End If
End Function

Function シート追加()
    Call シート削除
        
    Worksheets.Add after:=Worksheets(Worksheets.Count)
    Worksheets(Worksheets.Count).Name = "シート一覧"
    Range("A1") = "No."
    Range("B1") = "シート名"
    Range("C1") = "表示/非表示"
    
    Range("A1:C1").Select
    Selection.HorizontalAlignment = xlCenter
    With Selection.Interior
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.249977111117893
    End With
    Range("A1").Select
End Function

Function 列幅フィット()
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:C").EntireColumn.AutoFit
End Function

Sub シート全表示()
    Dim i As Long
    Application.ScreenUpdating = False
    
    For i = 1 To Sheets.Count
        Sheets(i).Visible = True
    Next i
    
    Application.ScreenUpdating = True
    Worksheets("シート一覧").Activate

End Sub

Sub シート全非表示()    '(アクティブシートを除く)
    Dim i As Long
    Dim idx As Long
    
    Application.ScreenUpdating = False
    idx = ActiveSheet.Index
    
    For i = 1 To Sheets.Count
        If i <> idx Then
            Sheets(i).Visible = False
        End If
    Next i
    
    Application.ScreenUpdating = True

End Sub

Sub シート選択表示()
    Dim i As Long
    
    Call シート全非表示
    Application.ScreenUpdating = False
    
    For i = 1 To Sheets.Count
        If Not IsEmpty(Cells(i + 1, 3)) Then
            Sheets(i).Visible = True
        End If
    Next i
    
    Application.ScreenUpdating = True
    Worksheets("シート一覧").Activate
End Sub

Sub 一覧作成()
    Dim i As Long
    Dim flag As Boolean
    
    flag = シート存在確認

    If flag Then
        Worksheets("シート一覧").Activate
        For i = 1 To Worksheets.Count
            Cells(i + 1, 1).Value = i
            ActiveSheet.Hyperlinks.Add Anchor:=Range("B" & i + 1), _
            Address:="", _
            SubAddress:="'" & Worksheets(i).Name & "'" & "!A1", _
            TextToDisplay:=Worksheets(i).Name
        Next
        Call 列幅フィット
    Else
        MsgBox "シートがありません。"
    End If
End Sub

Sub シート作成()
    Dim rc As Integer
    rc = MsgBox("処理を行いますか？", vbYesNo + vbQuestion, "確認")
    If rc = vbYes Then
        Call シート追加
    Else
        MsgBox "処理を中断します"
    End If
    
    Call 一覧作成
End Sub

参考(多分使わない)

Sub シート名一覧取得()
    Dim i As Long
    
    For i = 1 To Sheets.Count
        Cells(i + 1, 1).Value = i
        Cells(i + 1, 2).Value = Worksheets(i).Name
    Next
End Sub

参考サイト

後日に記載
・https://www.ka-net.org/blog/?p=8945
・https://qiita.com/tomochan154/items/3614b6f3ebc9ef947719#%E3%82%AB%E3%82%B9%E3%82%BF%E3%83%A0-ui-%E3%82%92%E5%AE%9A%E7%BE%A9%E3%81%99%E3%82%8B
・https://github.com/OfficeDev/office-custom-ui-editor
・https://www.ex-it-blog.com/131119Excel-sheet-mokuji-macro
・https://qiita.com/jp7eph/items/c8bf16b644dee82f9bfe