ワードのマクロについて

質問

お世話になります。
エクセルのマクロについてはここでよくアドバイスをもらっていますが、今回ワードでの処理について教えてください。

１つのフォルダにワード文書がたくさん入っています。
各ワード文書に対し以下の操作を自動化させたい。
１．すべてを選択（ctrl+A）
２．置換で「改行」をすべて削除
　　あいまい検索のチェックをはずした上で
検索する文字列　^p　　置換後の文字列は「空白」
　　すべて置換

３．置換で「スペース」をすべて削除
　　あいまい検索のチェックをはずした上で
検索する文字列　^w　　置換後の文字列は「空白」
　　すべて置換

４．すべてを選択
５．メニュー→書式→文字種の変換→全角にチェック→ＯＫ
　　　ですべての文字を全角にする

まとめると「すべての改行、スペースを削除し、全文字を全角に統一する」
この作業をフォルダ内の全ワード文書に対して一括で処理できないでしょうか？
ちなみにワード文書は元々メモ帳（*.txt）で作成されていたものをリネームソフトで拡張子を*.docに変換したものです。そのためファイルを閉じるときに「書式なし形式で使用できない機能が含まれています」と聞いてきますが「はい」でＯＫです。

アドバイスおねがいします。

回答No.2

kigoshi · ベストアンサー

以下のソースでできるのではないかと思います。

>あとどのワードからでもマクロは起動可能なのでしょうか？
「どのワードから」というのが不明ですが、Word起動後、標準モジュール内に下記コードを貼り付けて下さい。

Sub henkan()
Dim myPath
Dim crrFile
myPath = "c:\文書\"
crrFile = Dir(myPath)
Do Until crrFile = ""
If Right(crrFile, 4) = ".doc" Then
ChangeFileOpenDirectory myPath
Documents.Open FileName:=crrFile
Selection.WholeStory
Application.DisplayAlerts = wdAlertsNone

With Selection.Find '[改行削除処理]
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^p"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
.Execute Replace:=wdReplaceAll
End With

With Selection.Find '[スペース削除処理]
.ClearFormatting
.Replacement.ClearFormatting
.Text = "^w"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
.Execute Replace:=wdReplaceAll
End With

Selection.WholeStory
Selection.Range.CharacterWidth = wdWidthFullWidth '[半角→全角変換処理]

ActiveDocument.SaveAs FileName:=crrFile, FileFormat:=wdFormatText, AddToRecentFiles:=True
Application.DisplayAlerts = wdAlertsAll
ActiveWindow.Close
End If
crrFile = Dir
Loop
End Sub

お礼

ご回答ありがとうございます。
無事に作動してくれました。

回答No.1

kigoshi

置換や変換はマクロの記録などでコード解るかと思いますので、
全体の構成のコード例を以下に示します。
ご参考になれば。

Sub henkan()
Dim myPath
Dim crrFile
myPath = "c:\文書\"
crrFile = Dir(myPath)
Do Until crrFile = ""
If Right(crrFile, 4) = ".doc" Then
ChangeFileOpenDirectory myPath
Documents.Open FileName:=crrFile
Selection.WholeStory
［改行削除処理］
［スペース削除処理］
［半角→全角変換処理］
Application.DisplayAlerts = wdAlertsNone
ActiveDocument.SaveAs FileName:=crrFile, FileFormat:=wdFormatText, AddToRecentFiles:=True
Application.DisplayAlerts = wdAlertsAll
ActiveWindow.Close
End If
crrFile = Dir
Loop
End Sub

補足

ご回答ありがとうございます。ためしに［改行削除処理］を記録したのが下のコードです。
どういう形ではさめばよいのでしょうか？
あとどのワードからでもマクロは起動可能なのでしょうか？

Sub Macro1()

Selection.WholeStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub