【Word VBA】上付きに見えるけど上付きではない文字を上付きに変換するWordマクロ（その３）

2018年1月17日

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

最近、色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

-コード
-, , , ,