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 표준 시트 선택 대화 상자이지만 표시 시트가 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
참고 사이트
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
Reference
이 문제에 관하여(Excel VBA에서 시트 선택을 위한 사용자 양식 만들기), 우리는 이곳에서 더 많은 자료를 발견하고 링크를 클릭하여 보았다 https://qiita.com/R_TES_/items/b8bdc6d16bdf8c66a190텍스트를 자유롭게 공유하거나 복사할 수 있습니다.하지만 이 문서의 URL은 참조 URL로 남겨 두십시오.
우수한 개발자 콘텐츠 발견에 전념 (Collection and Share based on the CC Protocol.)