'セル移動を制御するサンプルマクロ4

'MakeSheet4を実行してサンプルシートを作成してください。

Option Explicit

Const CellMoveDefineRange = "CellMove"

Sub MakeSheet4()
    Application.ScreenUpdating = False
    Worksheets.Add
    With Range("A1")
        .Value = "Enterキーでセル移動するサンプルシート"
        .Font.ColorIndex = 5
        .Font.Bold = True
    End With
    Range("C2").Value = _
        "このシートではマクロを使い、Enterキーの動作を列単位に制御しています。"
    Range("C3").Value = "セル移動の定義情報は任意のセル範囲に作成します。"
    Range("C4").Value = _
        "IMEのオン・オフも行います。（ただしWindowsでのみ動作します。）"
    With Range("A6")
        .Value = "セル移動の定義情報"
        .Font.ColorIndex = 5
        .Font.Bold = True
    End With
    Range("A7").Value = _
        "CellMoveという名前を定義してください。場所はどこでも構いません。"
    Range("A8").Value = "1はIMEオン、2はIMEオフです。空白セルへは移動しません。"
    With Range("A9:E9")
        .Value = Array(2, "", 1, "", 2)
        .BorderAround Weight:=xlThick, ColorIndex:=5
        ActiveWorkbook.Names.Add Name:="CellMove", RefersTo:="=$A$9:$E$9"
    End With
    With Range("A11:E11")
        .Value = Array("項目1", "項目2", "項目3", "項目4", "項目5")
        .Font.Bold = True
    End With
    With Range("A2:B3")
        With ActiveSheet.Buttons.Add(.Left + .Width * 0.1, _
            .Top + .Height * 0.2, .Width * 0.8, .Height * 0.6)
            .Caption = "開始"
            .OnAction = "MyOnSheetActivate4_On"
        End With
    End With
    With Range("A4:B5")
        With ActiveSheet.Buttons.Add(.Left + .Width * 0.1, _
            .Top + .Height * 0.2, .Width * 0.8, .Height * 0.6)
            .Caption = "終了"
            .OnAction = "MyOnSheetActivate4_Off"
        End With
    End With
            
    Range("A12").Select
End Sub

'アクティブシートに自動実行マクロを登録するマクロ
Sub MyOnSheetActivate4_On()
    ActiveSheet.OnSheetActivate = "MyOnSheetActivate4"
    ActiveSheet.OnSheetDeactivate = "MyOnSheetDeactivate4"
    MyOnSheetActivate4
End Sub

'アクティブシートの自動実行マクロを解除するマクロ
Sub MyOnSheetActivate4_Off()
    ActiveSheet.OnSheetActivate = ""
    ActiveSheet.OnSheetDeactivate = ""
    MyOnSheetDeactivate4
End Sub

'キーの割り当てをするマクロ（自動実行マクロ）
Sub MyOnSheetActivate4()
    Application.OnKey "{ENTER}", "MyOnKeyEnter4"
    Application.OnKey "{RETURN}", "MyOnKeyEnter4"
    Application.OnKey "+{ENTER}", "MyOnKeyShiftEnter4"
    Application.OnKey "+{RETURN}", "MyOnKeyShiftEnter4"
End Sub

'キーの割り当てを解除するマクロ（自動実行マクロ）
Sub MyOnSheetDeactivate4()
    Application.OnKey "{ENTER}"
    Application.OnKey "{RETURN}"
    Application.OnKey "+{ENTER}"
    Application.OnKey "+{RETURN}"
End Sub

'Enterで起動するマクロ
Sub MyOnKeyEnter4()
    Dim r As Range
    Dim row1 As Long, row2 As Long, col1 As Long
    Dim i As Long, j As Long, n As Long
    Dim v As Variant

    On Error Resume Next
    Set r = Application.Evaluate(CellMoveDefineRange)
    On Error GoTo 0
    If r Is Nothing Then
        MsgBox "セル移動定義がありません。", vbExclamation, "自動セル移動"
        Exit Sub
    End If

    n = r.Columns.Count
    col1 = ActiveCell.Column
    row1 = ActiveCell.Row
    If row1 = ActiveSheet.Rows.Count Then
        row2 = row1
    Else
        row2 = row1 + 1
    End If

    If col1 <= n Then
        For i = row1 To row2
            For j = col1 + 1 To n
                v = r.Cells(1, j).Value
                If Not IsEmpty(v) Then
                    If IsNumeric(v) Then
                        If v = 1 Or v = 2 Then
                            ActiveSheet.Cells(i, j).Activate
                            SetIME CInt(v)
                            Exit Sub
                        End If
                    End If
                End If
            Next
            col1 = 0
        Next
    End If
End Sub

'Shift+Enterで起動するマクロ
Sub MyOnKeyShiftEnter4()
    Dim r As Range
    Dim row1 As Long, row2 As Long, col1 As Long
    Dim i As Long, j As Long, n As Long
    Dim v As Variant

    On Error Resume Next
    Set r = Application.Evaluate(CellMoveDefineRange)
    On Error GoTo 0
    If r Is Nothing Then
        MsgBox "セル移動定義がありません。", vbExclamation, "自動セル移動"
        Exit Sub
    End If

    n = r.Columns.Count
    col1 = ActiveCell.Column
    row1 = ActiveCell.Row
    If row1 = 1 Then
        row2 = row1
    Else
        row2 = row1 - 1
    End If

    If col1 <= n Then
        For i = row1 To row2 Step -1
            For j = col1 - 1 To 1 Step -1
                v = r.Cells(1, j).Value
                If Not IsEmpty(v) Then
                    If IsNumeric(v) Then
                        If v = 1 Or v = 2 Then
                            ActiveSheet.Cells(i, j).Activate
                            SetIME CInt(v)
                            Exit Sub
                        End If
                    End If
                End If
            Next
            col1 = n + 1
        Next
    End If
End Sub

'IMEのオンオフを行うマクロ（Windowsでのみ動作）
Sub SetIME(ByVal arg1 As Integer)
    Select Case arg1
        Case 1
            If IMEStatus = 2 Then SendKeys "%{KANJI}"
        Case 2
            If IMEStatus <> 2 Then SendKeys "%{KANJI}"
    End Select
End Sub