frog.raindrop.jp.knowledge

Option Explicit

Public Sub SetAllSheetZoom()

Dim sZoom           As String
Dim oItem           As Object
Dim workSheetItem   As Excel.Worksheet
Dim lRatio          As Long

On Error GoTo ErrHandler:

    Do
        sZoom = InputBox("全シートに設定する表示倍率を入力してください。" _
                            & vbLf & " ※「%」などをつけず、数値のみ入力してください。", "表示倍率の設定", ActiveWindow.Zoom)
        If (Len(Trim$(sZoom)) = 0&) Then
            Exit Sub
        End If

        If (IsNumeric(sZoom)) Then
            lRatio = CLng(sZoom)
            Exit Do
        End If

        Call MsgBox("数値を入力してください", vbExclamation)
    Loop

    For Each oItem In Application.ActiveWorkbook.Sheets
        If (TypeOf oItem Is Excel.Worksheet) Then
            Set workSheetItem = oItem
            Call workSheetItem.Select
            ActiveWindow.Zoom = lRatio
        End If
    Next oItem

    Exit Sub

ErrHandler:

    Call MsgBox("エラーが発生しました" _
                & vbLf & " Source: " & Err.Source _
                & vbLf & " Number: " & CStr(Err.Number) _
                & vbLf & Err.Description, vbCritical)

End Sub