【VBA】Excelマクロを利用して作業効率を上げたい①

Const 赤色 As Long = 255           
Const 青色 As Long = 15773696      
Const 黒色 As Long = 0             
Const 黄色 As Long = 65535         
Const 緑色 As Long = 5296274
Const 橙色 As Long = 49407
Const 灰色 As Long = 14277081      
Const 白色 As Long = 16777215

Sub ChangeFontColorCycle()
    Dim cell As Range
    For Each cell In Selection
        ' 赤の場合は青に変更 
        If cell.Font.Color = 赤色 Then
            cell.Font.Color = 青色
        ' 青の場合は黒に変更 
        ElseIf cell.Font.Color = 黒色 Then
            cell.Font.Color = 赤色
        Else
            cell.Font.Color = 黒色
        End If
    Next cell
End Sub


Sub CycleBackgroundColor()
    Dim cell As Range
    For Each cell In Selection
        ' 無色の場合は黄色に変更 
        If cell.Interior.Color = 白色 Then
            cell.Interior.Color = 黄色
        ' 黄色の場合は緑に変更 
        ElseIf cell.Interior.Color = 黄色 Then
            cell.Interior.Color = 緑色
        ' それ以外は設定しない 
        Else
            cell.Interior.Color = 白色
        End If
    Next cell
End Sub

Sub Move2A1()
    Dim ws As Object  ' ワークシートやその他シートを扱うため、Object型
    Dim zoomRatio As Variant
    Dim gridlinesOption As VbMsgBoxResult

    '【1】グリッド線の設定方法をユーザーに確認
    gridlinesOption = MsgBox( _
        "グリッド線（シートの枠線）の設定をどうしますか？" & vbCrLf & _
        "【はい】：枠線を表示する" & vbCrLf & _
        "【いいえ】：枠線を非表示にする" & vbCrLf & _
        "【キャンセル】：枠線は変更しない", _
        vbYesNoCancel + vbQuestion, "グリッド線設定の確認")

    '【2】拡縮比率をポップアップで入力
    zoomRatio = InputBox("すべてのシートに設定する拡縮比率を入力してください（10～400%）:", "拡縮比率設定")
    
    ' 入力が数値かどうか、かつ範囲チェック
    If IsNumeric(zoomRatio) Then
        If zoomRatio < 10 Or zoomRatio > 400 Then
            MsgBox "拡縮比率は10～400%の範囲で入力してください。", vbExclamation
            Exit Sub
        End If
    End If

    '【3】すべてのシートをループして処理
    For Each ws In ActiveWorkbook.Sheets
        If TypeOf ws Is Worksheet Then
            ' シートをアクティブに
            ws.Activate
    
            ' Ctrl + Home 相当の動作
            ws.Cells(1, 1).Select
            ActiveWindow.ScrollRow = 1
            ActiveWindow.ScrollColumn = 1
    
            ' 拡縮比率の設定
            If IsNumeric(zoomRatio) Then
                ActiveWindow.Zoom = zoomRatio
            End If
    
            ' グリッド線の表示設定
            Select Case gridlinesOption
                Case vbYes
                    ActiveWindow.DisplayGridlines = True
                Case vbNo
                    ActiveWindow.DisplayGridlines = False
            End Select
        End If
    Next ws
    
    ' 最後に1番目のシートに戻す（同様にスクロールもリセット）
    With ActiveWorkbook.Sheets(1)
        If TypeOf .Parent.Sheets(1) Is Worksheet Then
            .Activate
            .Cells(1, 1).Select
            ActiveWindow.ScrollRow = 1
            ActiveWindow.ScrollColumn = 1
        End If
    End With


    '【5】 完了メッセージ
    If IsNumeric(zoomRatio) Then
        MsgBox "すべてのシートでセル A1 を選択し、拡縮比率 " & zoomRatio & "% を設定しました！", vbInformation
    Else
        MsgBox "すべてのシートでセル A1 を選択しました！", vbInformation
    End If
End Sub

Private Sub Workbook_Open()
    ' Ctrl + Shift + R に MoveToA1 マクロを割り当て 
    Application.OnKey "^+r", "Move2A1"
    Application.OnKey "^+1", "ChangeFontColorCycle"
    Application.OnKey "^+2", "CycleBackgroundColor"
End Sub