【知らなくても使える】全シートの表示倍率とカーソル位置を一括で変更するアドイン（Excel VBA）

Option Explicit

'-----（設定値）------------------------
Private Const PLACE_FIRST = "A1"            '１．セル位置（カーソルをあてるアドレス）
Private Const ZOOM_INDEX_FIRST = "3"        '２．表示倍率の最初のインデックス
Private Const ZOOM_VALUE_FIRST = "100"      '３．表示倍率の最初の値
'---------------------------------------

Private RbRibbon As IRibbonUI               'リボン
Private PlacePoint As String                '貼り付け位置
Private ZoomValue As String                 '表示倍率
Private BeforePlace As String               '一つ前に指定した貼り付け位置

'===================================
'リボンの初期処理
'===================================
Sub onLoad_prestorage(ribbon As IRibbonUI)

    'リボンの表示を更新できるようにするためにリボンをセットする
    Set RbRibbon = ribbon
    RbRibbon.Invalidate
    
End Sub
 
'=====================================
'「セル位置」の最初の値を取得する
'=====================================
Sub TgtCellPoint_getText(control As IRibbonControl, ByRef returnValue)
    If PlacePoint = "" Then
        PlacePoint = PLACE_FIRST
        BeforePlace = PlacePoint
    End If
    returnValue = PlacePoint
End Sub

'=====================================
'「倍率」の最初の値を取得する
'=====================================
Sub drdn_tgtZoom_getIndex(control As IRibbonControl, ByRef index) ' DropDownの項目の選択を設定
    index = ZOOM_INDEX_FIRST
    ZoomValue = ZOOM_VALUE_FIRST
End Sub

'-------------------------
'「セル位置」に変更があった際の処理
'-------------------------
Sub TgtCellPoint_onChange(control As IRibbonControl, text As String)

On Error GoTo ErrHnd
    If Evaluate("ISREF(" & text & ")") Then
        PlacePoint = text
        BeforePlace = PlacePoint
    Else
        PlacePoint = BeforePlace
        MsgBox "「セル位置」は有効なアドレスを入力して下さい。"
    End If
    
    RbRibbon.InvalidateControl ("edbox_tgtCellPoint") ' editBoxの表示を更新する
    Exit Sub
    
ErrHnd:
    PlacePoint = BeforePlace
    MsgBox "「セル位置」は有効なアドレスを入力して下さい。"
    RbRibbon.InvalidateControl ("edbox_tgtCellPoint") ' editBoxの表示を更新する
End Sub

'-------------------------
'「倍率」に変更があった際の処理
'-------------------------
Sub TgtZoom_onAction(control As IRibbonControl, itemID As String, index As Integer)
    
    Dim zoomNum As Long: zoomNum = Replace(itemID, "Drd_Item_", "")
    
    '指定された倍率が数値でない場合は、一つ前の値を入れる
    If IsNumeric(zoomNum) Then
        ZoomValue = Str(zoomNum) & "%"
    End If
    
End Sub

'=====================================
'実行処理
'=====================================
Sub moveCell_onClick(control As IRibbonControl)

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    
    Dim wkSheet As Object
    
    For Each wkSheet In ActiveWorkbook.Worksheets
    
        If wkSheet.Visible = True Then
            wkSheet.Select
        
            'A1にカーソルを置く
            wkSheet.Range(PlacePoint).Select
    
            ActiveWindow.ScrollColumn = 1
            ActiveWindow.ScrollRow = 1
            
            Dim zoomNum As Long: zoomNum = Replace(ZoomValue, "%", "")
    
            '表示スケールを変更する
            If IsNumeric(zoomNum) Then
                ActiveWindow.Zoom = zoomNum
            End If
        End If
    Next
    
    '1番左のシートを選択
    Worksheets(1).Select
    
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub