このマクロには改良版があります。 【コード】上付きに見えるけど上付きではない文字を上付きに変換するWordマクロ(その1) 【コード】上付きに見えるけど上付きではない文字を上付きに変換するWordマクロ(その2) 【コード】上付きに見えるけど上付きではない文字を上付きに変換するWordマクロ(その3)
前回の記事「【コード】上付きに見えるけど上付きではない文字を上付きに変換するWordマクロ(その1)」の続きです。
上記の記事では、1文字1文字の書式を確認して処理をするFor Each…Nextステートメントを紹介しましたが、数十万文字の処理をする場合にはやはり時間がかかってしまいます。
この処理を高速化する考え方を紹介します。文字書式など1文字ずつ検証する必要がある処理には同じ考え方を適用できます。
このマクロでできること
上方にずれた位置にある文字を上付きに変換します。前回の記事「【コード】上付きに見えるけど上付きではない文字を上付きに変換するWordマクロ(その1)」と同じ処理です。
処理が高速化されています。
マクロの解説
1文字1文字の判定をするまえに、段落単位で文字書式の判定をしています。
1つの段落に「通常位置」の文字と「上方に位置する」文字が混在する場合、1つの段落のフォントのpositionプロパティの値は、一様ではない(wdUndefined)となるわけです。(16行目の判定)
1つの段落に「通常位置」の文字しかない場合には、もちろんpositionプロパティが0になります。
こういう癖を判定に用いています。段落ごとに判定したあとは、単語ごとに判定し、最終的にwdUndefinedになった単語の場合だけ1文字ずつ位置を判定するというわけです。(18行目の判定)
なお、段落の判定のあとに文章の判定がなくて単語の判定になる理由ですが、これはWordのオブジェクトがそのような構造になっているからです。Sentenceオブジェクトは存在しないので、Paragraphオブジェクトの次の階層のオブジェクトをWordオブジェクトにしているのです。 Sentenceオブジェクトがあります。Rangeオブジェクトで表現します。改良版(その3)で修正しました。(2018年1月17日)
マクロ
Sub 上方に位置する文字を上付きに変換する3() Dim myChar As Range Dim myWord As Range Dim myPara As Paragraph Dim myDoc As Document Dim a As Single Dim b As Single Dim c As Single a = Timer() Set myDoc = ActiveDocument For Each myPara In myDoc.Paragraphs If myPara.Range.Font.Position = wdUndefined Then For Each myWord In myPara.Range.Words If myWord.Font.Position = wdUndefined Then For Each myChar In myWord.Characters With myChar If .Font.Position > 0 Then .Font.Position = 0 .Font.Superscript = True .HighlightColorIndex = wdBrightGreen End If End With Next End If Next End If Next b = Timer() c = Round(b - a, 2) MsgBox "終わりました。" & vbCr & c & "秒" End Sub