wordマクロで条件に合う文のみフォント変更

質問

wordの文章で、“（１）”という文字列を検索して次に現れる改行（vbCr）までの文章をゴシック体＆ボールド体にしたいと思っています。
ファイル中に“（１）”から始まる文はいくつもあります。そのすべてを一括変換したいのですが、どのようなコードで出来るのでしょうか？
よろしくお願いします。

回答No.9

KenKen_SP · ベストアンサー

なんか、、#7 が2重投稿になってますね（汗）

> （1）テスト見出し1
> （2）テスト見出し2
> の部分のみがゴシック＋太字の書式になれば良いのです。

結果の認識についてすれ違いはないですね。Word2002 では縦書きでも問題
ありませんでした。どうも、環境の違いが原因ぽいのですけど、断定できる
だけの確証がありません。

では、#3 のコードで次のように修正したらどうなりますか？

　　.EndOf Unit:=wdParagraph, Extend:=wdExtend
　　　　　　　　　　　↓
　　.EndOf Unit:=wdSentence, Extend:=wdExtend

お礼

思い通りの処理が出来るようになりました。
ありがとうございました。

補足

出来ました！ありがとうございます。

コードの修正できちんと処理されました。
しかも、処理にかかる時間もほんの一瞬ですね。

とりあえず処理したい文字列のパターンがすべて正規表現できるかやってみます。

回答No.10

misatoanna

> （1）テスト見出し1
> （2）テスト見出し2
> の部分のみがゴシック＋太字の書式になれば良いのです。
いまさら、ですが、試行錯誤してみたら、一般機能の置換処理でもできますね。　　（Word2000）

置換ダイアログの[オプション]を開いて、ワイルドカード使用 にチェックを入れ、
　検索する文字列： ^13[(（【○◎]*^13
　　　　　　　　　　　　　　[　] の中には、見出しの文頭に使っている記号や文字を入れます。
　置換後の文字列： ^&
　　　　　　　　　　　　　　更に、[書式]-[フォント] から ゴシック体と太字を指定。
で [すべて置換] をクリックします。

（１）あああああ
（２）いいいいい
のように、置換対象となる文字列が２行続くと置換されないものがありますが、見出しの
次に必ず本文があるのでしたら、問題ないと思います。

お礼

ありがとうございます。
なるほど、そういう方法もあるんですね。
それだったらマクロを自動記録するだけですね。

ですがよく見たら、置換対象となる文字列は２行続く事がありました…

回答No.7

KenKen_SP

うーーん。。すれ違いがあるようですね。

こちらが想定しているのは、例えば、下記のサンプルデータを Word にコピペ
して、マクロを実行すると、

（1）テスト見出し1
（2）テスト見出し2

の部分だけが、ゴシック＋太字の書式になり、本文はそのままのはずです。

【サンプルデータ】
（1）テスト見出し1
　本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル。
　本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル。
（2）テスト見出し2
SampleData SampleData SampleData SampleData SampleData SampleData SampleData SampleData SampleData.

【サンプルデータ　ここまで】

意図したものとは違ってますか？ 補足頂いた内容は、

（1）テスト見出し1　本文サンプル本文サンプル....

のように改行が入らないとそうなるかもしれませんが、これだとご質問の仕様
と違いますから....

> “（１）”という文字列を検索して次に現れる改行（vbCr）までの文章を
> ゴシック体＆ボールド体にしたい

どこが食い違ってますか？

回答No.8

KenKen_SP

うーーん。。すれ違いがあるようですね。

こちらが想定しているのは、例えば、下記のサンプルデータを Word にコピペ
して、マクロを実行すると、

（1）テスト見出し1
（2）テスト見出し2

の部分だけが、ゴシック＋太字の書式になり、本文はそのままのはずです。

【サンプルデータ】
（1）テスト見出し1
　本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル。
　本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル本文サンプル。
（2）テスト見出し2
SampleData SampleData SampleData SampleData SampleData SampleData SampleData SampleData SampleData.

【サンプルデータ　ここまで】

意図したものとは違ってますか？ 補足頂いた内容は、

（1）テスト見出し1　本文サンプル本文サンプル....

のように改行が入らないとそうなるかもしれませんが、これだとご質問の仕様
と違いますから....

> “（１）”という文字列を検索して次に現れる改行（vbCr）までの文章を
> ゴシック体＆ボールド体にしたい

どこが食い違ってますか？

補足

仰るとおり、上のサンプルでいきますと、
（1）テスト見出し1
（2）テスト見出し2
の部分のみがゴシック＋太字の書式になれば良いのです。

コピペしてマクロを実行しましたところやはり前回と同じように文章すべてがゴシック＋太字になってしまいます。

となると、環境の違いでしょうか。改行がおかしいのかも知れません。
WORD2000の縦書きですが、これは問題ないですよね？

回答No.6

KenKen_SP

> ...改行されたときに元に戻りません。

すみません。意味がわからないです。具体的にどういうことなのでしょうか？
普通、書式は自動では元に戻らないと思いますが...

> 処理がものすごく速い気がしますが。

Find を使ってキーワードを検索していますので、ループ回数は必要最小限に
なってます。

> ...（１）や（２）のような簡単なパターンだけじゃなく“【”や“○”や
> “◎”が含まれるものもあります

#3 の下記の検索パターンを修正することで、いかようにも対応します。

　　.Text = "[\(（][0-9０-９]{1,}[\)）]"　'<-- 検索パターン

正規表現による検索なので、正規表現で表せる以上は何パターンあろうとも
一括で処理可能です。

上のパターンは前半角対応で（数字）を表しています。

補足

度々すみません。
「改行されたときに元に戻らない」とは具体的に、
文書の最初に現れる（１）で太文字ゴシックに変換されるのですが、そのまま文書の最後まで変換されたままになってしまうという事です。

処理としましては、次の改行で元のフォント（明朝）に戻し、また該当文字列があった時に太文字ゴシックを開始する…　と繰り返したいのです。

正規表現で表せれば、検索文字列がいくつあろうと一括処理が出来るんですね。
それは是非挑戦してみたいと思います。

回答No.5

misatoanna

ごめんなさい、訂正です。

> ChkChar = ")"
　ChkChar = "("
で、括弧の向きが逆でした。

回答No.4

misatoanna

＃１です。こんばんは。

> 実は、（１）以外にも当然（２）、（３）・・・とあるわけでして
なのでしたら、私の方法の場合は次の２箇所を変更すればよいと思います。

ChkChar = "(1)"　　'← 太字にする先頭文字列です。
　　↓
ChkChar = ")"　　　'← 太字にする先頭文字列を指定

Select Case Selection & Selection.Next & Selection.Next.Next
　　↓
Select Case Selection

もちろん （１）、（２）、‥‥、以外には、(　) で囲まれる文字列が無いとしてのこと
なのですが。

あと、
NXT: Loop
の部分は、ただの　Loop　にしてください。
試行錯誤の名残でした。

補足

度々ありがとうございます。
下にも書きましたが、パターンが結構いろいろありまして、一度の処理では不可能です。

30回この処理を実行すると、すごく時間がかかってしまいます。その中には“（１）”のように3文字のものもあれば、“【”のように1文字のものもあります。したがって、
Select Case Selection & Selection.Next & Selection.Next.Next
の部分も検索文字数によって変えなければなりません。
まぁ、この辺は自分で考えないといけませんね。

もう少し自分でも試行錯誤してみます。

回答No.3

KenKen_SP

> 実は、（１）以外にも当然（２）、（３）・・・とあるわけでして、

なら、こんな感じでどうですか？ （２）、（３）にも対応しますよ。

Sub Sample()

　　Dim Rng As Range
　　For Each Rng In ActiveDocument.StoryRanges
　　　　With Rng.Find
　　　　　　.Text = "[\(（][0-9０-９]{1,}[\)）]"　'<-- 検索パターン
　　　　　　.MatchWildcards = True
　　　　　　Do While .Execute(Forward:=True)
　　　　　　　　With Rng
　　　　　　　　　　.EndOf Unit:=wdParagraph, Extend:=wdExtend
　　　　　　　　　　' フォント指定
　　　　　　　　　　.Font.Name = "ＭＳ ゴシック"
　　　　　　　　　　' 太字指定
　　　　　　　　　　.Font.Bold = wdToggle
　　　　　　　　　　.Collapse wdCollapseEnd
　　　　　　　　End With
　　　　　　Loop
　　　　End With
　　Next Rng

End Sub

補足

度々ありがとうございます。
試してみましたが、（１）や（２）以降フォントが変わるのですが、改行されたときに元に戻りません。
このままコピペで実行してもダメなんでしょうか？
成功すれば、処理がものすごく速い気がしますが。

あと、具体的に拾いたい文字列は、（１）や（２）のような簡単なパターンだけじゃなく“【”や“○”や“◎”が含まれるものもあります。
全部で30パターン以上あります。
そうなると一気に処理をするのは難しいと思うので、文字列ごとにプロシジャを走らせるか、ループさせるかしかないと思うのですが、処理速度が気になります。

回答No.2

KenKen_SP

こんにちは。KenKen_SP です。

こんな感じでも OK。....（１）というのは段落番号じゃないよね？

Sub Sample()

　　Dim Rng As Range
　　For Each Rng In ActiveDocument.StoryRanges
　　'For Each Rng In ActiveDocument.StoryRanges

　　　　With Rng.Find
　　　　　　.Text = "\(1\)"　'<-- 検索パターン
　　　　　　.MatchCase = False
　　　　　　.MatchByte = False
　　　　　　.MatchWildcards = True
　　　　　　Do While .Execute(Forward:=True)
　　　　　　　　With Rng
　　　　　　　　　　.EndOf Unit:=wdParagraph, Extend:=wdExtend
　　　　　　　　　　' フォント指定
　　　　　　　　　　.Font.Name = "ＭＳ ゴシック"
　　　　　　　　　　' 太字指定
　　　　　　　　　　.Font.Bold = wdToggle
　　　　　　　　　　.Collapse wdCollapseEnd
　　　　　　　　End With
　　　　　　Loop
　　　　End With
　　Next Rng

End Sub

お礼

どうもありがとうございます。
（１）は段落番号じゃなく文字列です。要するに見出しとして目立たせたいのです。

KenKen_SPさんのコードはまだ試せていませんが、是非試してみたいと思います。
（１）だけでなく他にもたくさんの文字列があり、今後は処理時間をいかに縮めるかという事でやってみようと思います。

回答No.1

misatoanna

私なりの方法例です。
検索機能を使わないで文頭から文字チェックしていますので、少々時間がかかります。
３行目の (1) はすべて半角にしてありますが、実際の文字列に書き換えてください。
また、「次に現れる改行(vbCr)」とありますが、ここでは [Enter] 単体で改行された
段落記号(Ascコード＝13) のみを対象にしています。
なお、[Shist]+[Enter] の「任意指定の行区切」のAscコードは 11、[Ctrl]+[Enter] の
改ページは 12 です。

Sub Kakko1()
　Dim ChkChar
　ChkChar = "(1)"　　　'← 太字にする先頭文字列です。
　Selection.EndKey Unit:=wdStory
　ActiveDocument.Bookmarks.Add Range:=Selection.Range, Name:="E"
　Selection.HomeKey Unit:=wdStory
　Do Until Selection.Range.Bookmarks.Exists("E")
　　Selection.MoveRight Unit:=wdCharacter, Count:=1
　　On Error GoTo Fin
　　Select Case Selection & Selection.Next & Selection.Next.Next
　　　Case Is = ChkChar
　　　　Do Until Asc(Selection.Next) = 13
　　　　　Selection.MoveRight Unit:=wdCharacter, Count:=1, _
　　　　　　　　　　　　　　　　　　　　Extend:=wdExtend
　　　　Loop
　　　　With Selection.Font
　　　　　.Name = "ＭＳ Ｐゴシック"
　　　　　.Bold = wdToggle
　　　　End With
　　End Select
NXT: Loop
Fin: ActiveDocument.Bookmarks("E").Delete
End Sub

お礼

どうもありがとうございます。
お教え頂いたコードで一発解決しました。
自分ではこんなコードは書けませんでした。

実は、（１）以外にも当然（２）、（３）・・・とあるわけでして、そうなってくると処理時間が気になります。
kakko1(str As Stirng)として引数を設定し、メインのコードからいちいちコールしたのですが、やはりすごく時間がかかります。配列に文字列を入れ、For文で処理しようとしてのですがうまくいきませんでした。
この辺はまた考えたいと思います。
とりあえず処理は出来るようになりましたので本当に感謝しています。どうもありがとうございました。