Excel VBAでシート選択用のユーザーフォームを作成する

やりたいこと：シートの選択ダイアログをショートカットで呼び出したい
やったこと：VBAで作成した

はじめに

次の記事でExcelのショートカットについて書きました。
ショートカットを活用しよう - 15 - (Excel) Ctrl + (矢印キー, Home, End, PageUp, PageDown) - Qiita
この記事にてシート選択についてVBAで作ったものを利用している旨を記載しています。

そういえば、最近使っていなくて探してみても見つからなかったので作り直しました。

VBAで作成する理由として、元々あるシート選択のダイアログをショートカットで呼べないのか調べてみましたが、見当たらず、Application.Dialogsにもそれらしいものを見つけられなかったこと。
また、非表示シートを見れないためです。

イメージ

まず、Excel標準のシート選択のダイアログですが、表示シートが16を超える場合、選択できるようになるみたいです。


※Sheet2を非表示にしています。

作ったフォームは次のように表示されます。

※フォームのCaptionとフォントはデフォルトから変更しています。

ソースコード

ユーザーフォームを作成し、リストボックスを貼り付けて、コードを貼り付ければ動くはずです。
現段階では、細かいチェックはあまり出来ていません。

Option Explicit

Private TargetBook As Workbook
Private SheetVisible As New Collection
Private SelectedIndex As Integer

'Windows API宣言
Private Const GWL_STYLE = (-16)
Private Const WS_THICKFRAME = &H40000
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetActiveWindow Lib "user32" () As Long
Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

' フォームをリサイズ可能にするための設定
Public Sub FormSetting()
Dim result As Long
Dim hwnd As Long
Dim Wnd_STYLE As Long
    hwnd = GetActiveWindow()
    Wnd_STYLE = GetWindowLong(hwnd, GWL_STYLE)
    Wnd_STYLE = Wnd_STYLE Or WS_THICKFRAME Or &H30000

    result = SetWindowLong(hwnd, GWL_STYLE, Wnd_STYLE)
    result = DrawMenuBar(hwnd)
End Sub

Private Sub UserForm_Activate()
    Call FormSetting
    Call GetSheets
End Sub

Private Sub UserForm_Resize()
    ListBox1.Top = 0
    ListBox1.Left = 0
    ListBox1.Width = Me.InsideWidth
    ListBox1.Height = Me.InsideHeight
End Sub

Private Sub GetSheets()
Dim objSheet As Worksheet
Dim SheetName As String
Dim i As Integer
Dim v As Variant
Dim SelecteChars As New Collection

    Set TargetBook = ActiveWorkbook

    'ショートカット用の文字 1-9, 0, A-Z
    For Each v In Array(Array(49, 57), Array(48, 48), Array(65, 90))
        For i = v(0) To v(1)
            SelecteChars.Add Chr(i)
        Next
    Next

    i = 1
    For Each objSheet In TargetBook.Worksheets
        SheetVisible.Add objSheet.Visible

        SheetName = SelecteChars(i) & "|": i = i + 1
        If objSheet.Visible <> xlSheetVisible Then
            SheetName = SheetName & "(非表示) "
        End If
        SheetName = SheetName & objSheet.Name

        ListBox1.AddItem SheetName
    Next

    SelectedIndex = TargetBook.ActiveSheet.Index
    ListBox1.Selected(SelectedIndex - 1) = True

    'フォームサイズ変更 TODO:その内、APIで文字等修得して幅と高さを自動調整出来るようにする
    Me.Width = 320
    Me.Height = 240
End Sub

Private Sub ListBox1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)
    If KeyAscii = vbKeyReturn Or KeyAscii = vbKeyEscape Then
        Unload Me
    End If
End Sub

Private Sub ListBox1_Click()
    With TargetBook
        If .Worksheets(ListBox1.ListIndex + 1).Visible <> xlSheetVisible Then
            .Worksheets(ListBox1.ListIndex + 1).Visible = xlSheetVisible
        End If
        .Worksheets(ListBox1.ListIndex + 1).Select
        .Worksheets(SelectedIndex).Visible = SheetVisible(SelectedIndex)
    End With
    SelectedIndex = ListBox1.ListIndex + 1
End Sub

Private Sub ListBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Dim i As Integer
Dim isSelected As Boolean
    '現在表示中のシートが元々非表示の場合、元に戻す
    If SheetVisible(SelectedIndex) <> xlSheetVisible Then
        'まずは後に続くシートで最初に見つかった非表示意外のシートを選択する
        For i = ListBox1.ListIndex + 1 To ListBox1.ListCount - 1
            If SheetVisible(i + 1) = xlVisible Then
                TargetBook.Worksheets(i + 1).Select
                isSelected = True
                Exit For
            End If
        Next
        '選択されていない場合、前方に一つずつ戻って最初に見つかった非表示意外のシートを選択する
        For i = ListBox1.ListIndex - 1 To 0 Step -1
            If SheetVisible(i + 1) = xlVisible Then
                TargetBook.Worksheets(i + 1).Select
                Exit For
            End If
        Next
        TargetBook.Worksheets(SelectedIndex).Visible = SheetVisible(SelectedIndex)
    End If
End Sub

参考サイト

• 「Excel] [VBA] ユーザーフォームをリサイズ可能にする | プロプログラマ -Flex,Air,C#,Oracle,PHP-