【コード】上付きに見えるけど上付きではない文字を上付きに変換するWordマクロ(その2)

前回の記事「【コード】上付きに見えるけど上付きではない文字を上付きに変換する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オブジェクトにしているのです。

マクロ


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

トップへ戻る