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

質問

wordの文章で、“（注）”もしくは“(注)”という文字列を検索して次に現れる空白改行までの文章を9ptにし変えた部分にマーカーをしたいと思っています。
(注)から始まる文章は

(注)あああああ。

(注)ああああ。いいいいい。

(注)ああああ。
　　（1）いいいいい。
　　　　(1)ううううう。
　　　　(2)えええええ。

等のパターンがあります。現行では”ああああ”しか9ptになりませんが本当は全て9ptにしたいと思っています。どなたがご教授願います。

Sub SizeChenge9()

Dim Rng As Range

For Each Rng In ActiveDocument.StoryRanges

With Rng.Find

.Text = "[\(（][注][\)）]"
.MatchWildcards = True

Do While .Execute(Forward:=True)
If Rng.Information(wdWithInTable) = False Then
With Rng
.EndOf Unit:=wdSentence, Extend:=wdExtend
.Font.Size = 9
.HighlightColorIndex = wdPink
.Collapse wdCollapseEnd
End With
End If
Loop

End With

Next Rng

End Sub

回答No.4

Wendy02 · ベストアンサー

こんばんは。

結局、元のマクロは全面的に書き換えることにしました。いくらやっても、認識しない部分があったからです。パラグラフの先頭に、番号等が入れてあることが条件ですから、そうでない場合は、うまく行きません。

一応、マル付き数字は、検索値には入れていますが、おそらくは生きていません。それは、段落番号であって、段落番号として認識したら、色付けされます。元のご質問のコードとは、考え方が違いますから、もしかしたら、思い違いがあるかもしれません。そうしたら、マクロはうまく行きません。

このマクロの考え方は、パラグラフの先頭に、段落番号を探しエラーが発生したら、その先頭文字を探し、その段落数字のパラグラフをマーカーとフォントを変換する。また、エラーが発生しなかったら、そのパラグラフ全体を変換します。

'-------------------------------------------

Sub ChagNumberFont()
　　Dim p As Paragraph
　　Dim i As Long
　　On Error Resume Next
　　With ActiveDocument.Content
　　　　For Each p In .Paragraphs
　　　　　　p.SelectNumber
　　　　　　If Err.Number = 0 Then
　　　　　　　　With p.Range
　　　　　　　　　　.EndOf Unit:=wdParagraph, Extend:=wdExtend
　　　　　　　　　　.HighlightColorIndex = wdPink
　　　　　　　　　　.Font.Size = 9
　　　　　　　　End With
　　　　　　Else
　　　　　　　　If CheckParagraph(Selection.Range, i) Then
　　　　　　　　　 If i = 0 Then
　　　　　　　　　　　　p.Range.Font.Size = 9
　　　　　　　　　　　　p.Range.HighlightColorIndex = wdPink
　　　　　　　　　　Else
　　　　　　　　　　　 With Selection
　　　　　　　　　　　　　.HomeKey Unit:=wdLine
　　　　　　　　　　　　　.MoveRight Unit:=wdCharacter, Count:=i, Extend:=wdMove
　　　　　　　　　　　　　.MoveEnd Unit:=wdLine, Count:=1
　　　　　　　　　　　　　.Range.Font.Size = 9
　　　　　　　　　　　　　.Range.HighlightColorIndex = wdPink
　　　　　　　　　　　　 .Collapse Direction:=wdCollapseEnd
　　　　　　　　　　　 End With
　　　　　　　　　　End If
　　　　　　　　　　i = 0
　　　　　　　　End If
　　　　　　End If
　　　　　　Err.Clear
　　　　Next
　　End With
　　On Error GoTo 0
End Sub

Function CheckParagraph(ByRef rng As Range, ByRef i As Long)
Dim Ar As Variant
Dim strTxt As String
Dim s As Variant
Dim flg As Boolean
Dim ln As Long
　 flg = False
　 '(1)(2)は、[マル1,マル2] です。自動変換されています。
　 Ar = Array("[(（]?[）)]*", "[(1)(2)]", "[２-４]", "・")
　 ln = Len(rng.Text)
　 strTxt = Replace(rng.Text, Space(1), "", , , 1)
　 i = ln - Len(strTxt)
　 For Each s In Ar
　　　If strTxt Like s & "*" Then
　　　　If Not Mid(strTxt, 2) Like "*" & s & "*" Then
　　　　　 flg = True
　　　　　 Exit For
　　　　End If
　　　End If
　 Next
　 CheckParagraph = flg
End Function

補足

ありがとうございます。
月初でバタついてしまい遅くなって申し訳ありませんでした。
Sub ChagNumberFont()
Dim p As Paragraph
Dim i As Long
On Error Resume Next
With ActiveDocument.Content
For Each p In .Paragraphs
p.SelectNumber
If Err.Number = 0 Then
With p.Range
.EndOf Unit:=wdParagraph, Extend:=wdExtend
.HighlightColorIndex = wdPink
.Font.Size = 9
End With
Else
★ If CheckParagraph(Selection.Range, i) Then
If p.Range.Information(wdWithInTable) = False Then
If i = 0 Then
p.Range.Font.Size = 9
p.Range.HighlightColorIndex = wdPink
Else
With Selection
.HomeKey Unit:=wdLine
.MoveRight Unit:=wdCharacter, Count:=i, Extend:=wdMove
.MoveEnd Unit:=wdLine, Count:=1
.Range.Font.Size = 9
.Range.HighlightColorIndex = wdPink
.Collapse Direction:=wdCollapseEnd
End With
End If
i = 0
End If
End If
End If

Err.Clear
Next
End With
On Error GoTo 0
End Sub

に関しては★を付け加えました。
Function CheckParagraph(ByRef rng As Range, ByRef i As Long)
Dim Ar As Variant
Dim strTxt As String
Dim s As Variant
Dim flg As Boolean
Dim ln As Long
　 flg = False
　 '(1)(2)は、[マル1,マル2] です。自動変換されています。
　 Ar = Array("[(（]?[）)]*", "[(1)(2)]", "[２-４]", "・")
　 ln = Len(rng.Text)
　 strTxt = Replace(rng.Text, Space(1), "", , , 1)
　 i = ln - Len(strTxt)
　 For Each s In Ar
　　　If strTxt Like s & "*" Then
　　　　If Not Mid(strTxt, 2) Like "*" & s & "*" Then
　　　　　 flg = True
　　　　　 Exit For
　　　　End If
　　　End If
　 Next
　 CheckParagraph = flg
End Function

に関してですが初心者の私には難解で解読中です。
このまま動かすと
（注）あああ。
（注）あああ。
（注）あああ。
と３つ並んでいる所は一番下しかかかりません。
あと、（イ）（ロ）（２）（３）のかかって欲しくない所にもかかります。
（イ）（ロ）など「～以外」とする事は可能なのでしょうか？
ちなみにAr = Array("[(（]?[）)]*", "[(1)(2)]", "[２-４]", "・")
の？に「注」を入れたら(1)(2)←カッコ1、2がかからなくなりました。

回答No.6

Wendy02

こんばんは。

返事が遅くなりました。もう先週に回答を書いておきながら、そのままになってしまいました。

残念ながら、#4のマクロでダメでしたら、そのままの文書ですと無理だと思います。一旦、別のソフト--たとえば、Excelのように、本来の文字のベタ（入力した文字と見えている状態が一致してる）入力に上乗せする書式のようなものでないと出来ないのです。

Wordでは、一部は直せることは出来ても、もう片方がだめになるということになってしまいます。結局のところは、それほど変わらないと思います。完全には出来ません。今回の対象の文書は、大きくわけると、Wordの機能で書かれた部分と、ベタ書きになっているものとが混合された文書ではないかと思うからです。#4のコードがダメだった理由です。

#4 で全面的に換えたのは、本来、Wordの機能を使って段落の先頭に付けたWordの機能で付けられた番号（段落番号）に対して変更するように想定しています。意図しないところで、色が付けられた理由です。

きちんとした規則によって変更するように出来ていますが、システムから付けられた段落番号自体の内容は判定は出来ないのです。ベタ書きなら、仮にフィールド状態でも条件によって可能ですが、この段落番号の場合は区分けができません。

段落番号を使わないというような条件下なら、もう一度、マクロを書くことは可能ですが、Wordの機能を使わないで本当のベタ書きで文書を作るというのは、なかなか無理ではないかと思います。マクロはあくまでも補助的な立場ですから、そのための文章を書き直すことはナンセンスです。

段落番号は、すべて変換するか、しないか、どちらかひとつです。

また、たとえば、以下のようなところで、誤動作する場合は、確実にパラグラフとして分かれていないようです。別の回答でも、私のWordのコードに関してクレームを付けた方がいましたが、単に日本語の「段落」という言葉でまとめてしまうと誤解されてしまいます。あくまでも、[Return]コードで分かれている部分に対して行うもので、それを、こちらからは、その内容について万能なコードで、パラグラフになっているのか、そうでないのかの区分けに同じように働くように書くことは出来ないからです。

>（注）あああ。
>（注）あああ。
>（注）あああ。
>と３つ並んでいる所は一番下しかかかりません。

上の二つと、三番目の部分だけ、違う書式になっているとしか思えません。一定の規則によって書かれたものなら、同じように反応するはずですが、そこに違う入力の仕方をしたものに対して、マクロでは判定が出来ません。やり方によっては可能という人もいるとは思いますが、私は、この部分をピンポイントで区分けするだけのマクロを書くと、逆に別のところで誤動作しかねないように思うのです。

長くなりましたが、以上の状況で、残念な結果をお伝えしなければなりませんでした。
ここの掲示板では、自信家の回答者さんたちもいますから、私の書いた内容を批判する人もいるとは思いますが、私の考えは、今の時点では、こういう考えで間違いないとしか思えないのです。そうでないとありえない現象だからです。

お礼

ありがとうございます。
>（注）あああ。と３つ並んでいる所にかからなかったのは（注）の中の文章に（）があるとかからなかったようです。
試行錯誤した結果下記の様なマクロになりました。これで一応かけたい所にはかかります。
しかし文言が変わったり小さな変化で書き直さなくてはならなくなるので
これから（注）と改行が２つ続いている所（１つ目の改行は文章後、２つ目の改行は行に文章がない）の位置を取得しその間をPTを変えるのが出来ればと考えています。
Wendy02の記述方法には初めてみるものもありとても勉強になりました。
ありがとうございました。
もしまた何かあればご教授宜しくお願い致します。

Public C As Boolean

Sub ChagNumberFont()
Dim p As Paragraph
Dim i As Long
On Error Resume Next
With ActiveDocument.Content
For Each p In .Paragraphs
p.Range.Select
If CheckParagraph(Selection.Range, i) Then
p.Range.Font.Size = 9
p.Range.HighlightColorIndex = wdPink
p.Range.EndOf Unit:=wdParagraph, Extend:=wdExtend
End If
Err.Clear
Next
End With
On Error GoTo 0
End Sub

Function CheckParagraph(ByRef rng As Range, ByRef i As Long)
Dim Ar As Variant
Dim strTxt As String
Dim s As Variant
Dim flg As Boolean
Dim ln As Long
flg = False
Ar = Array("[（(]注[)）]", "[（(][1-2１-２][)）]", "[(1)(2)]", "・", "[１-６]", "[債]")
ln = Len(rng.Text)
strTxt = Replace(rng.Text, Space(1), "", , , 1)
i = ln - Len(strTxt)
For Each s In Ar
If strTxt Like s & "*" Then
If rng.Information(wdWithInTable) = False Then
If (s = Ar(4) Or s = Ar(1)) And C = False Then Exit For
flg = True
Exit For
End If
End If
Next

If flg = True And s = Ar(0) Then
C = True
ElseIf flg = False Then
C = False
End If
CheckParagraph = flg
End Function

回答No.5

Wendy02

#4の補足訂正
>× '(1)(2)は、[マル1,マル2] です。自動変換されています。
'(1)(2)は、[マル1,マル2] です。掲示のために自動変換されていますから、元のマル付き文字に書き換えてください。

回答No.3

Wendy02

こんにちは。

ひとつにまとめるためには、こちらが、確実に、きちんと理解していないと、私自身、ベタ書きにコード(For ～ Next)を書くしかありません。「？クエスチョンマーク」が文中に出てきますが、Unicode のようにも思えてきます。その部分を確かめていただけますか？こちらも、できれば、コードの全体を崩さずに、検索値とオブションだけで、他は付け加えずに済ませたいです。

>変わって欲しくない場所にもかかってしまうため
というのは、補足の中にありますか？どういうものですか？

'-------------------------------------------
　.Text = "[\(（][注1-2][\)）]"　←半角の1～2
　.Text = "?" 　　　　二つあるので良く分かりません
　.Text = "?"　　　　　　〃
　.Text = "[２-４]．" '全角の２～４
　.Text = "・"　　'中黒点

'-------------------------------------------
.Text = "?" ←これは、Unicode ミドット（・）のことですか？ここのサイトは、Unicode はサポートされてはいませんが、文字を貼り付けると確か、文字コードが出てきたはずです。文字コードがあれば、こちらは内容は分かります。

なお、上記の条件なら、
　.MatchByte = False
　　　↓
　.MatchByte = True

になりますね。

補足

申し訳ありません。
？になっている所に入れたかったのはマル1、マル2です。
β版で先程開いていており補足入力ではきちんと入力されていたので確認してませんでした。

変わって欲しくない場所は
（１）、（２）、（３）
１．、２．、３．
あああ・ああああ

が他の場所にありまして「あああ・ああああ」に関しては「・ああああ」にマクロがかかってしまいました。
つまり注記として書かれているもののみマクロをかけたいと思っています。

他に注記には下記の様な種類もあります。
（注）１．ああああ
　　　　　いいいい。
　　　２．うううう。
　　　３．ええええ。
　　　４．おおおお。

回答No.2

Wendy02

こんばんは。

>最後の一つは★の所に改行があるため”(注)ああああ。”しかかかりません。
もし、以下が、ひとつのパラグラフになっていれば、全部に色が付きますが、それは、それぞれがパラグラフになっていますので、それぞれを検索します。

>(注)ああああ。★
>　　（1）いいいいい。★
>　　　　(1)ううううう。★
>　　　　(2)えええええ。★

これ全体をパラグラフにするのも良いのですが、今度は、最初の質問の検索記号を使って、こうします。

　With Rng.Find
　　　　　.ClearFormatting
　　　　　.Text = "[\(（][注0-9][\)）]"
　　　　　.MatchByte = False
　　　　　.MatchWholeWord = True
　　　　　.MatchWildcards = True　'ワイルドカード--True　以下の設定と相対関係
　　　　　.MatchFuzzy = False　　　'あいまい検索--False
　　　　　.Format = True

補足

ありがとうございます。
これで（注）（1）等は出来ますね。
すいません、私の説明不足だったのですが
（注）１．ああああ
　　　（1）いいいい
　　　　?うううう
　　　　?うううう
　　　　　・ええええ
　　　　　・ええええ
　　　（2）いいいい
　　　２．ああああ
　　　３．ああああ
　　　４．ああああ

とあります。

.Text = "[\(（][注0-9][\)）]"を
.Text = "[\(（][注0-9０?９][\)）]"
とすれば２．３．４．もかかりますが、変わって欲しくない場所にもかかってしまうため

.Text = "[\(（][注1-2][\)）]"
.Text = "?"
.Text = "?"
.Text = "[２-４]．"
.Text = "・"

を別々にForNextで回す方法でなら変えたい場所が変わりました。
これを少ないForNextもしくは他の方法でスマートに書く方法はございますか？

回答No.1

Wendy02

こんにちは。

>“（注）”もしくは“(注)”という文字列を検索して次に現れる空白改行

空白改行という単語の意味が理解できないのですが、改行までというなら、wdParagraph です。(厳密には、改行という言い方はおかしいです）そうでないなら、その取得したParagraph のRange.Text から、空白や書式記号などの位置を探さなくてはならないと思います。

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

'-------------------------------------------
それと、
>“（注）”もしくは“(注)”という文字列を検索して
ということでしたら、以下のようにしても良いと思います。

.Text = "[\(（][注][\)）]"
　　　↓
　　.Text = "(注)"　
　　.MatchByte = False
　　.MatchWildcards = False
　　.MatchFuzzy = True
　　.Format = True

なお、.MatchWildcards = True にするなら、　.MatchFuzzy = False このプロパティも念のために加えておきます。それから、念のために、.ClearFormatting　も加えてください。エラーや誤動作をさせないためです。Word VBAは、略さないようにしてください。表の検索等の設定が残っていることがあります。

補足

ありがとうございます。

(注)あああああ。

(注)ああああ。いいいいい。

(注)ああああ。★
　　（1）いいいいい。★
　　　　(1)ううううう。★
　　　　(2)えええええ。★

上の２パターンは出来ました！
しかし最後の一つは★の所に改行があるため”(注)ああああ。”しかかかりません。
このため”(2)えええええ。”の下に文字が何もない改行記号のみの行があるため、それを探せればマクロがかかるかなと思ったのです。
言い方がよく解らず空白改行などと書いてしまいましたが…。
これだと空白の位置を探す必要があるのでしょうか？