Option Explicit
Public nRow As Long
Public nCol As Long

Sub auto_open()

    Application.OnKey "{F1}", ""                    'F1を押してもヘルプを表示させない　（こちらを参照）
    Application.OnKey "+^I", "toUP"                  'Shift + Ctrl + I　カーソル上移動
    Application.OnKey "+^J", "toLEFT"                'Shift + Ctrl + J　カーソル左移動
    Application.OnKey "+^K", "toRIGHT"               'Shift + Ctrl + K　カーソル右移動
    Application.OnKey "+^N", "toDOWN"                'Shift + Ctrl + N　カーソル下移動
    Application.OnKey "+^H", "DELETE"                'Shift + Ctrl + H　セル内容削除
    Application.OnKey "+^B", "InsertLine"            'Shift + Ctrl + B　行挿入
    Application.OnKey "+^O", "LineAutoFit"           'Shift + Ctrl + O　行の高さを最適化
    Application.OnKey "+^P", "ColumnAutoFit"         'Shift + Ctrl + P　列の幅を最適化
    Application.OnKey "+^L", "列幅折り返し表示"      'Shift + Ctrl + L　列幅で折り返し表示設定と解除
    Application.OnKey "+^D", "文字左詰め表示"        'Shift + Ctrl + D　文字左詰め表示
    Application.OnKey "+^C", "文字中央揃い表示"      'Shift + Ctrl + C　文字中央揃い表示
    Application.OnKey "+^F", "文字右詰め表示"        'Shift + Ctrl + F　文字右詰め表示
    Application.OnKey "+^M", "ウィンドウ最少化"      'Shift + Ctrl + M　ウィンドウ最小化
    Application.OnKey "+^U", "ZoomUp"                'Shift + Ctrl + U　画面５％ズームUp
    Application.OnKey "+^Y", "ZoomDown"              'Shift + Ctrl + Y　画面５％ズームDown
    Application.OnKey "+%{UP}", "charaBIG"           'Shift + Alt + ↑　文字サイズ　＋１ポイント
    Application.OnKey "+%{DOWN}", "charaSMALL"       'Shift + Alt + ↓　文字サイズ　−１ポイント
    Application.OnKey "%{RIGHT}", "列幅微増"         'Alt + →        　列幅の微増
    Application.OnKey "%{LEFT}", "列幅微減"          'Alt + ←        　列幅の微減
    Application.OnKey "+^T", "Cell結合"              'Shift + Ctrl + T　選択セルの結合と結合解除
    Application.OnKey "%{UP}", "セル縦位置UP"        'Alt + ↑        　文字縦位置の変更（下→中央、中央→上）
    Application.OnKey "%{DOWN}", "セル縦位置DOWN"    'Alt + ↓        　文字縦位置の変更（上→中央、中央→下）
    Application.OnKey "+^%{RIGHT}", "FindNextRight"  'Shift + Ctrl + Alt + →　次の入力済みセルに移動（右方向）
    Application.OnKey "+^%{LEFT}", "FindNextLeft"    'Shift + Ctrl + Alt + ←　次の入力済みセルに移動（左方向）
    Application.OnKey "+^%{UP}", "FindNextUp"        'Shift + Ctrl + Alt + ↑　次の入力済みセルに移動（上方向）
    Application.OnKey "+^%{DOWN}", "FindNextDown"    'Shift + Ctrl + Alt + ↓　次の入力済みセルに移動（下方向）
    Application.OnKey "^{PGDN}", "Next_Sheet_Active"     'Ctrl + PageDown　アクティブシート切り替え（右方向・サイクリック）
    Application.OnKey "^{PGUP}", "Prior_Sheet_Active"    'Ctrl + PageUp　アクティブシート切り替え（左方向・サイクリック）
	
End Sub

Sub toUP()

    nRow = ActiveCell.Row
    nCol = ActiveCell.Column
    
    If nRow > 1 Then
        Cells(nRow - 1, nCol).Select
    End If

End Sub

Sub toLEFT()

    nRow = ActiveCell.Row
    nCol = ActiveCell.Column
    
    If nCol > 1 Then
        Cells(nRow, nCol - 1).Select
    End If

End Sub

Sub toRIGHT()

    Dim tmpCol As Long
    nRow = ActiveCell.Row
    nCol = ActiveCell.Column
    tmpCol = nCol
    
    If Selection.MergeCells Then
        Do
            If nCol = 256 Then Exit Sub
            nCol = nCol + 1
            Cells(nRow, nCol).Select
        Loop Until Not Selection.MergeCells Or tmpCol <> ActiveCell.Column
    Else
        If nCol <> 256 Then Cells(nRow, nCol + 1).Select
    End If
   
'    If nCol <> 256 Then
'        Cells(nRow, nCol + 1).Select
'    End If

End Sub

Sub toDOWN()

    Dim tmpRow As Long
    nRow = ActiveCell.Row
    nCol = ActiveCell.Column
    tmpRow = nRow
    
    If Selection.MergeCells Then
        Do
        If nRow = 65536 Then Exit Sub
            nRow = nRow + 1
            Cells(nRow, nCol).Select
        Loop Until Not Selection.MergeCells Or tmpRow <> ActiveCell.Row
    Else
        If nRow <> 65536 Then Cells(nRow + 1, nCol).Select
    End If
    
'    If nRow <> 65536 Then
'        Cells(nRow + 1, nCol).Select
'    End If

End Sub

Sub FindNextRight()

    nRow = ActiveCell.Row
    nCol = ActiveCell.Column
    Do
        nCol = nCol + 1
        If nCol > ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column Then
            nCol = 1
            nRow = nRow + 1
            If nRow > ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row Then
                nRow = 1
            End If
        End If
        If Cells(nRow, nCol).Value <> "" Then
            Cells(nRow, nCol).Select
            Exit Do
        End If
    Loop

End Sub

Sub FindNextLeft()

    nRow = ActiveCell.Row
    nCol = ActiveCell.Column
    Do
        nCol = nCol - 1
        If nCol < 1 Then
            nCol = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
            nRow = nRow - 1
            If nRow < 1 Then
                nRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
            End If
        End If
        If Cells(nRow, nCol).Value <> "" Then
            Cells(nRow, nCol).Select
            Exit Do
        End If
    Loop

End Sub

Sub FindNextUp()

    nRow = ActiveCell.Row
    nCol = ActiveCell.Column
    Do
        nRow = nRow - 1
        If nRow < 1 Then
            nRow = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
            nCol = nCol - 1
            If nCol < 1 Then
                nCol = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column
            End If
        End If
        If Cells(nRow, nCol).Value <> "" Then
            Cells(nRow, nCol).Select
            Exit Do
        End If
    Loop

End Sub

Sub FindNextDown()

    nRow = ActiveCell.Row
    nCol = ActiveCell.Column
    Do
        nRow = nRow + 1
        If nRow > ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row Then
            nRow = 1
            nCol = nCol + 1
            If nCol > ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Column Then
                nCol = 1
            End If
        End If
        If Cells(nRow, nCol).Value <> "" Then
            Cells(nRow, nCol).Select
            Exit Do
        End If
    Loop

End Sub

Sub DELETE()

    Selection.ClearContents

End Sub

Sub InsertLine()

    Selection.EntireRow.Insert

End Sub

Sub ZoomUp()

    If ActiveWindow.Zoom < 396 Then
        ActiveWindow.Zoom = ActiveWindow.Zoom + 5
    End If

End Sub

Sub ZoomDown()

    If ActiveWindow.Zoom > 30 Then
        ActiveWindow.Zoom = ActiveWindow.Zoom - 5
    End If

End Sub

Sub charaBIG()

    With Selection.Font
        .Size = .Size + 1
        If .Size > 300 Then
            .Size = 300
        End If
    End With

End Sub

Sub charaSMALL()

    With Selection.Font
        If .Size >= 2 Then
            .Size = .Size - 1
        End If
    End With

End Sub

Sub LineAutoFit()

    nRow = ActiveCell.Row
    nCol = ActiveCell.Column
    Rows(nRow).Select
    Selection.EntireRow.AutoFit
    Cells(nRow, nCol).Select

End Sub

Sub ColumnAutoFit()

    nRow = ActiveCell.Row
    nCol = ActiveCell.Column
    Columns(nCol).Select
    Selection.EntireColumn.AutoFit
    Cells(nRow, nCol).Select

End Sub

Sub ウィンドウ最少化()

    Application.WindowState = xlMinimized

End Sub

Sub 列幅微増()

    Selection.ColumnWidth = Selection.ColumnWidth + 1

End Sub

Sub 列幅微減()

    If Selection.ColumnWidth > 1 Then
        Selection.ColumnWidth = Selection.ColumnWidth - 1
    Else
        Selection.ColumnWidth = 0
    End If

End Sub

Sub セル縦位置UP()

    With Selection
        If .VerticalAlignment = xlBottom Then
            .VerticalAlignment = xlCenter
            Exit Sub
        End If
        If .VerticalAlignment = xlCenter Then
            .VerticalAlignment = xlTop
            Exit Sub
        End If
        .VerticalAlignment = xlTop
    End With

End Sub

Sub セル縦位置DOWN()

    With Selection
        If .VerticalAlignment = xlTop Then
            .VerticalAlignment = xlCenter
            Exit Sub
        End If
        If .VerticalAlignment = xlCenter Then
            .VerticalAlignment = xlBottom
            Exit Sub
        End If
        .VerticalAlignment = xlBottom
    End With

End Sub

Sub 列幅折り返し表示()

    With Selection
        If .WrapText = True Then
            .WrapText = False
        Else
            .WrapText = True
        End If
    End With

End Sub

Sub 文字左詰め表示()

    With Selection
        .HorizontalAlignment = xlLeft
    End With

End Sub

Sub 文字中央揃い表示()

    With Selection
        .HorizontalAlignment = xlCenter
    End With

End Sub

Sub 文字右詰め表示()

    With Selection
        .HorizontalAlignment = xlRight
    End With

End Sub

Sub Cell結合()

    With Selection
        If .MergeCells = False Then
            .MergeCells = True
            .HorizontalAlignment = xlCenter
        Else
            .MergeCells = False
        End If
    End With

End Sub

Sub Next_Sheet_Active()
'
    Dim sheet_cnt As Long
    Dim activesheetname As String
    Dim ws As Variant
    Dim i As Long
    
    sheet_cnt = ActiveWorkbook.Sheets.Count
    activesheetname = ActiveWorkbook.ActiveSheet.Name
    For i = 1 To sheet_cnt
        If ActiveWorkbook.Sheets(i).Name = activesheetname Then
            Exit For
        End If
    Next
    
    Do
        i = i + 1
        If i > sheet_cnt Then i = 1
        If ActiveWorkbook.Sheets(i).Visible = True Then
            ActiveWorkbook.Sheets(i).Select
            Exit Do
        End If
    Loop
'
End Sub

Sub Prior_Sheet_Active()
'
    Dim sheet_cnt As Long
    Dim activesheetname As String
    Dim ws As Variant
    Dim i As Long
    
    sheet_cnt = ActiveWorkbook.Sheets.Count
    activesheetname = ActiveWorkbook.ActiveSheet.Name
    For i = 1 To sheet_cnt
        If ActiveWorkbook.Sheets(i).Name = activesheetname Then
            Exit For
        End If
    Next
    
    Do
        i = i - 1
        If i < 1 Then i = sheet_cnt
        If ActiveWorkbook.Sheets(i).Visible = True Then
            ActiveWorkbook.Sheets(i).Select
            Exit Do
        End If
    Loop
'
End Sub