【Word VBA】全角文字を検索するWordマクロ(Symbolフォントを除外)

先日いただいたコメントへの回答です。

この新田さんのマクロを、2バイト文字検索に応用できませんか?いままでこちらのフリーウェアを使っていたのですが、↓
http://www.vector.co.jp/soft/win95/writing/se375946.html
Word 2010に対応していません・・・

用途は、英訳時のチェックで、全角文字の検索をしているのですが、symbolフォントで正しく入力されているギリシャ文字は検索対象外としたいのです。

お時間のあるときで良いので、ご教示頂ければ、とてもありがたく存じます。

以前紹介しました「文書中の全角文字を数えて検索するマクロ」では、Symbolフォントも検索されてしまいます。

Symbolフォントを除外して全角文字を探してみます。

このマクロでできること

カーソルのあるストーリー 内において、カーソル以降の全角文字と思われるものを検索し、見つかった場合に選択します。ストーリーの末尾になったら、文書の先頭から検索を開始します。

Symbolフォントは、検索対象から除外します。

マクロの解説

9行目で、全角文字1文字を検索しています。

.Text = "[! -~^9^11^12^13^14]"

「全角文字」としていますが、かなり簡略化した記載です。ここで定義しているのは、「文書中の全角文字を数えて検索するマクロ」で紹介したとおり、半角文字( -~)と編集記号(^9^11^12^13^14)以外を探しています。

半角文字を見つけた場合に、23行目~24行目にあるように、フォント名を確認しています。
Symbolフォントだった場合には、選択を解除して別の文字を探すようになっています。

myRange.Select
 If Dialogs(wdDialogInsertSymbol).Font = "Symbol" Then

Dialogs(wdDialogInsertSymbol) は、[記号と特殊文字]の挿入用のダイアログボックスを示しています。

このダイアログボックスを開くとわかりますが、「現在選択されている文字列の先頭の1文字」の情報を表示するんですね。

そんなわけで、フォント名を確認する場合には、検索対象を1文字にしているのです。

myRange.Select で選択してから、このダイアログボックスでフォント名を確認しています。

Rangeオブジェクト内のフォント情報を表示できません。Selectionオブジェクトのフォント情報になります。

このマクロはかなり簡易的なものです。

半角文字が選択されてしまたら、その文字列を検索対象から除外するか、フォント名で除外するかしてみてください。

マクロ


Sub 全角文字の検索()

 'シンボルフォントを除外
 Dim myRange As Range
 
 Set myRange = Selection.Range
 
 With myRange.Find
  .Text = "[! -~^9^11^12^13^14]"
  .Replacement.Text = ""
  .Forward = True
  '.Wrap = wdFindContinue '無限ループにはまります!
  .Wrap = wdFindAsk '文書の末尾でメッセージが出ます
  .Format = False
  .MatchCase = False
  .MatchWholeWord = False
  .MatchByte = False
  .MatchAllWordForms = False
  .MatchSoundsLike = False
  .MatchFuzzy = False
  .MatchWildcards = True
  Do While .Execute = True
   myRange.Select
   If Dialogs(wdDialogInsertSymbol).Font = "Symbol" Then
    myRange.Collapse wdCollapseEnd
   Else
    Exit Do
   End If
  Loop
 End With

 Set myRange = Nothing
 
End Sub

関連記事

文書中の全角文字を数えて検索するマクロ

コメント

  • 4. Re:うまく動くのですが・・・

    >内田明子さん

    ご確認をありがとうございました!
    おっしゃるとおり、これループで回ってしまいますね。
    ご迷惑をかけました。

    修正しておきます。

  • 3. うまく動くのですが・・・

    新田さん、こんにちは。

    先日は有り難うございました!

    このマクロ、実際の案件で試してみた結果、検索自体はうまく動作するのですが、ループして止まらなくなってしまいました。

    .Wrap = wdFindContinue
    の部分を
    .Wrap = wdFindAsk
    で置き換えたら、文末で止まるようになりました。

    念のためご報告します。

    有り難うございました!

    内田明子 返信する
  • 2. Re:有り難うございました!

    >内田明子さん

    お試しいただきありがとうございます。

    Symbolフォント以外を除外するのであれば、正規表現を使った別のアプローチもあるかもしれません。

    細かく設定するといろいろできそうな気がします。お試しください。

  • 1. 有り難うございました!

    なるほど~。フォントタイプを確認して、symbolだったら除外するという動作ですか!

    正規表現を使おうと思わなくてもよかったということですね!!

    お忙しい中、本当にありがとうございました!

    内田明子

トップへ戻る