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

以下の記事の改良版です。
【コード】上付きに見えるけど上付きではない文字を上付きに変換するWordマクロ(その1)
【コード】上付きに見えるけど上付きではない文字を上付きに変換するWordマクロ(その2)

最近、色deチェックのユーザーさんからいただいたサンプルファイルで、文字位置をずらして上付き・下付き書式にする表記を拝見しました。

このサンプルファイルを見て気がついたのですが、文字位置を上下にずらすときにはたいていフォントのサイズも小さくしますね。たとえば、こんな感じです。

この場合、前回紹介したマクロを実行すると、7ポイントの箇所が上付き書式でさらに小さな文字になり、座りが悪くなります。

そこで、今回紹介するマクロでは、位置が上方向にずれている文字のフォントのサイズを直前の文字サイズに合わせるように修正しました。

また、高速化をさらに図りました。

このマクロでできること

上方向に位置がずれている文字を上付き書式に変換します。また、文字のサイズも修正します。

マクロの解説

28行目で、処理対象の文字列の1文字前の文字のフォントサイズを取得しています。

myChar.Previous

Previous メソッドにより、オブジェクトの1つ前の同じ階層のオブジェクトを取得できます。

今回は、myCharが文字オブジェクトなので、1文字前の文字オブジェクトを取得できます。

Previous メソッドを使えば、文字だけではなく、1段落前や1単語前の取得もできますね。

あと、18行目と19行目を追加しました。

前回のマクロでは、段落単位で判定をしたのちにいきなり単語単位での判定になりました。これは間違いです。段落>文章>単語>文字 と1つずつ階層を下がることで効率的に判定ができます。

今回のマクロは前回のマクロよりも高速に処理できます。

マクロ


Sub 上方に位置する文字を上付きに変換する4()

 Dim myChar As Range
 Dim myWord As Range
 Dim mySentence 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 mySentence In myPara.Range.Sentences
    If mySentence.Font.Position = wdUndefined Then
     For Each myWord In mySentence.Words
      If myWord.Font.Position = wdUndefined Then
       For Each myChar In myWord.Characters
        With myChar
         If .Font.Position > 0 Then
          With .Font
           .Position = 0
           .Superscript = True
           .Size = myChar.Previous.Font.Size
          End With
          .HighlightColorIndex = wdBrightGreen
         End If
        End With
       Next
      End If
     Next
    End If
   Next
  End If
 Next

 b = Timer()
 c = Round(b - a, 2)

 MsgBox "終わりました。" & vbCr & c & "秒"

End Sub

トップへ戻る