やりたいこと:シートの選択ダイアログをショートカットで呼び出したい
やったこと: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