複数のWord文書に対して文字列置換

Pocket

フォルダを指定し、その中のWord文書に対して、文字列の置換をするマクロです。
まず置換前の文字列と置換後の文字列を入力します。
その後、フォルダを選択します。
実行されるとファイルを開き置換を行い上書き保存します。これを繰り返します。

Sub 複数文書連続処理_文字列置換()
    '置換文字列の指定
    mae = InputBox("置換前の文字列を入力してください。", "置換前")
    If mae = "" Then Exit Sub
    ato = InputBox("置換後の文字列を入力してください。", "置換後")
    If ato = "" Then Exit Sub
    'フォルダの選択
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "フォルダを選択"
        .AllowMultiSelect = False
        If .Show = -1 Then
            mypath = .SelectedItems(1) & "\"
        Else
            MsgBox "終了します。"
            Exit Sub
        End If
    End With
    '実行
    res = MsgBox(mypath & "のフォルダ内のWord文書について「" & mae & "」を「" & ato & "」に置換します。よろしいですか。", vbOKCancel)
    If res = vbCancel Then Exit Sub
    myfile = Dir(mypath & "*.doc*")
    Do While myfile <> ""
        Documents.Open FileName:=mypath & myfile
        Call 文書全体を置換(mae, ato)
        ActiveWindow.Close SaveChanges:=wdSaveChanges
        myfile = Dir
    Loop
End Sub
Function 文書全体を置換(mae, ato)
    Set myRange = ActiveDocument.Range(Start:=0, End:=0)
    With myRange.Find
        .ClearFormatting
        .Text = mae
        With .Replacement
            .ClearFormatting
            .Text = ato
        End With
        .Execute Replace:=wdReplaceAll
    End With
End Function

関連記事

[ 2016年1月12日 | カテゴリー: Word | タグ: ]

« | »

コメント

  1. ramerika より:

    mypath = .SelectedItems(1) & “”

    mypath = .SelectedItems(1) & “\”
    ではないですか?

  2. stabucky より:

    ramerikaさん
    ご指摘のとおりです。修正しました。ありがとうございました。

  3. perlsky より:

    大変参考になりましのた。しかしながら、これだとヘッダ部分置換が出来ないようです。
    Function の中を以下の通りに変更したところ、ヘッダの置換もうまく行きました。
    Dim myStoryRange As Range

    For Each myStoryRange In ActiveDocument.StoryRanges
    With myStoryRange.Find
    .Text = mae
    .Replacement.Text = ato
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
    End With
    Do While Not (myStoryRange.NextStoryRange Is Nothing)
    Set myStoryRange = myStoryRange.NextStoryRange
    With myStoryRange.Find
    .Text = mae
    .Replacement.Text = ato
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
    End With
    Loop
    Next myStoryRange

  4. stabucky より:

    perlsky さん
    StoryRangesを使うのですね。ありがとうございます。

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

送信してください。


タグ

カテゴリー

最近の投稿

最近のコメント

固定ページ

アーカイブ

stabucky

写真

メタ情報