Excel addin sheet一覧

''' ThsisWorkBookに追加
''' ^ -> [Ctrl]
''' + -> [Shift]
''' % -> [Alt]
Private Sub Workbook_Open()
    Application.OnKey "^{s}", "Sheet一覧"
End Sub

''' [Alt]+[S]のショートカット割り当てをExcel標準に戻す
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Application.OnKey "^{s}", ""
End Sub

Private Sub sheetList_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
    ActiveWorkbook.Sheets(sheetList.Value).Select
End Sub
''' シートを選択
Private Sub sheetList_Click()
    ActiveWorkbook.Sheets(sheetList.Value).Select
End Sub

Private Sub sheetList_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    ActiveWorkbook.Sheets(sheetList.Value).Select
    Unload UserForm1
End Sub

Private Sub sheetList_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
    Select Case KeyCode
        Case vbKeyEscape
            Unload UserForm1
        Case vbKeyReturn
            ActiveWorkbook.Sheets(sheetList.Value).Select
            Unload UserForm1
    End Select
End Sub

Private Sub UserForm_Initialize()
    For Each i In ActiveWorkbook.Sheets: sheetList.AddItem i.Name: Next i
End Sub

''' 標準モジュール
'Windows APIの構造体の定義
Private Type POINT
  x As Long
  y As Long
End Type

Private Type RECT
  Left   As Long
  Top    As Long
  Right  As Long
  Bottom As Long
End Type

Private Declare Function SetCursorPos Lib "user32" _
                          (ByVal x As Long, ByVal y As Long) As Long

'フォームサイズ取得関係のAPIの宣言
Private Declare Function GetWindowRect Lib "user32" _
                          (ByVal hwnd As Long, lpRect As RECT) As Long

Declare Function FindWindowA Lib "user32" (ByVal clpClassName As String, _
                                           ByVal lpWindowName As String) As Long

Sub Sheet一覧()
    UserForm1.Show vbModeless

    Dim Mp As POINT
    Dim hwnd As Long
    Dim lpRect As RECT

    hwnd = FindWindowA("ThunderDFrame", UserForm1.Caption)

    'フォームのウィンドウのサイズを取得して構造体にセット
    GetWindowRect hwnd, lpRect

    '構造体よりフォームの中央の座標値を計算
    With lpRect
        lngCenterHeight = (.Bottom - .Top) \ 2 + .Top
        lngCenterWidth = (.Right - .Left) \ 2 + .Left
    End With

    'その座標値にマウスポインタを移動
    SetCursorPos lngCenterWidth, lngCenterHeight

End Sub