トップ　>　備忘録　>　選択フォルダ内のWordファイルの表示倍率を一括で変更

Sub All_Documents_ZoomChange() 'メイン
    Dim strDirPath As String
    Dim strExistDir As String
    strDirPath = Search_Directory()
    If Len(strDirPath) = 0 Then Exit Sub
    strExistDir = IsExistence_Directory(strDirPath)
    If Len(strExistDir) = 0 Then Exit Sub
    Call Search_Documents(strDirPath)
End Sub

Private Function Search_Directory() As String 'フォルダの選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then Search_Directory = .SelectedItems(1)
    End With
End Function

Private Function IsExistence_Directory(ByVal DirPath As String) As String 'フォルダ存在確認
    IsExistence_Directory = Dir(DirPath, vbDirectory)
End Function

Private Sub Search_Documents(ByVal strPath As String) '各ファイルの倍率変更
    Dim strTarget As String
    Dim strDirPath As String
    Dim varZoom As Variant
    strPath = strPath & Application.PathSeparator
    strTarget = Dir(strPath & "*.doc?")
    If strTarget = "" Then Exit Sub
    Do
        varZoom = InputBox("倍率を指定して下さい(10～500)", , 100)
        If Len(varZoom) = 0 Then Exit Sub
    Loop Until IsNumeric(varZoom)
    varZoom = CLng(varZoom)
    If varZoom < 10 Or 500 < varZoom Then
        MsgBox "指定できる数値は10～500の間です", vbExclamation, "中止します"
        Exit Sub
    End If
    Do
        With Word.Documents.Open(strPath & strTarget)
            If ActiveWindow.View.Zoom <> varZoom Then
                ActiveWindow.View.Zoom = varZoom
                .Saved = False 'ここがポイント
                .Save
            End If
            .Close
        End With
        strTarget = Dir()
    Loop Until strTarget = ""
    strTarget = Dir("")
End Sub

Sub UseFileDialogOpen()
    Dim lngCount As Long
    ' ファイル ダイアログを開きます。
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = True 'ファイルの複数選択を可能にする
        .Show
        ' 選択された各ファイルのパスを表示します。
        For lngCount = 1 To .SelectedItems.Count
            MsgBox .SelectedItems(lngCount)
        Next
    End With
End Sub