Word2000 不要な半角スペースを削除するマクロ作れますか？

質問

Word2000で文章を校正しています。
英数字と日本語の間は半角スペースを入れないのがルールなのですが、
原稿には、不要な半角スペースが大量に含まれており、困っています。

例>>
おしえて△goo → おしえてgoo
Microsoft△と△Oracle で → MicrosoftとOracleで

このような半角スペースを一括で置換するマクロを作ることは
(技術的に)可能でしょうか。
また、Word の既存機能を使って、
このような半角スペースを特定することができますでしょうか。
不要なのは、英数字と日本語に挟まれた半角スペースのみです。

ご存じの方がいらっしゃいましたら、
よろしくご教示ください。ｂ

回答No.4

Wendy02 · ベストアンサー

こんには。

>英数字と日本語の間は半角スペースを入れないのがルールなのですが、

通常は、和字とANSIの間には半角スペースを入れるはずですが。

正規表現の話が出ていましたので、一応、正規表現で行いました。Wordのワイルドカードは似ていますが、正規表現とは違います。特に、「*」「?」が違うように思います。もしかしたら、ワイルドカードで出来るかもしれませんが、あまり期待できないような気がします。

それと、国内のWeb サイトに参考になるようなWord　VBAは出ていないと思います。ただし、Word97のサンプルは、どこかの出版社のサイトには残っているはずです。ただ、早い話、マイクロソフト・サポートには、まだぎっしり、Word　VBAのコードが残っています。整理されていないのが、残念です。

なお、以下は、Word　2003を使って作っていますが、メソッドのプロパティ等は、Word2000のそれとチェックはしております。Wordマクロは、Excelとは違い、戻すことが可能ですが、一応、バックアップはしておいてください。

'---------------------------------------------------------------
Sub OneByteSpaceDeleteProc()
　Dim objRegExp As Object
　Dim myPattern As Variant
　Dim ReplaceWords As String
　Dim Matches As Object
　Dim Match As Object
　Set objRegExp = CreateObject("VBscript.RegExp")
　'
　Selection.HomeKey Unit:=wdStory
　Selection.EndKey Unit:=wdStory, Extend:=wdExtend
　'和字の半角カタカナは省きます。
　For Each myPattern In Array("[、-龍]\s+[0-~]+", "[0-~]+\s+[、-龍]")
　With objRegExp
　　.Global = True
　　.IgnoreCase = True
　　.Pattern = myPattern
　　If .Test(Selection) Then
　　　Set Matches = .Execute(Selection)
　　　For Each Match In Matches
　　　　'半角、vbBinaryCompare
　　　　ReplaceWords = Replace(Match.Value, " ", "", , , vbBinaryCompare)
　　　　myReplace Match.Value, ReplaceWords
　　　Next Match
　　　End If
　　End With
　Next myPattern
　　Selection.HomeKey Unit:=wdStory
　　MsgBox "終了", 64
　Set objRegExp = Nothing
End Sub

'Wordのプロパティは、省略しないでくださいね。
Sub myReplace(SearchWd As String, ReplaceWd As String)
　Selection.Find.ClearFormatting
　　Selection.Find.Replacement.ClearFormatting
　　With Selection.Find
　　　　.Text = SearchWd
　　　　.Replacement.Text = ReplaceWd
　　　　.Forward = True
　　　　.Wrap = wdFindContinue
　　　　.Format = False
　　　　.MatchCase = False
　　　　.MatchWholeWord = False
　　　　.MatchByte = True
　　　　.MatchAllWordForms = False
　　　　.MatchSoundsLike = False
　　　　.MatchWildcards = False
　　　　.MatchFuzzy = False
　　End With
　　Selection.Find.Execute Replace:=wdReplaceAll
End Sub

p.s.　そのまま、Selection をReplace で置き換えようとすると、置き換えるたびに、CR コードが入るので、このようなサブルーチン型にしました。

お礼

おおおおおおおっ!!
素晴らしい。
見事に、一発で日本語と英数字の間の半角だけが削除されました。
コードまで書いていただいてありがとうございました。
このやり方で対応しようと思います。

マイクロソフトのサポートページ、私も参照してみます。