Range.PhoneticGuideメソッドを使いやすくする(Word)

[Range].PhoneticGuideメソッドを使いやすくする

[Range].PhoneticGuideメソッドはちょい使いにくいので、使いやすく改良。

改良したコード

[Range].PhoneticGuideメソッドは、何といっても引数Raiseが超絶わかりにくい。ゆえに、[Range].PhoneticGuideメソッドをラップして使いやすくした。

リスト１

Private Const MS_P_GOTHIC As String = "ＭＳ Ｐゴシック"
Private Const MS_GOTHIC As String = "ＭＳ ゴシック"
Private Const MS_MINGZHAO As String = "ＭＳ 明朝"
Private Const MS_P_MINGZHAO As String = "ＭＳ Ｐ明朝"

Private Const DEFAULT_RUBYSIZE As Long = 5

Private Sub callPhoneticGuide( _
              ByVal tgtRange As Range, _
              ByVal tgtRubyText As String, _
              ByVal tgtOffset As Long, _
     Optional ByVal tgtRubySize As Long = DEFAULT_RUBYSIZE, _
     Optional ByVal tgtFontName As String = MS_P_MINGZHAO, _
     Optional ByVal tgtAlignment As WdPhoneticGuideAlignmentType = _
                                      wdPhoneticGuideAlignmentOneTwoOne)
  '引数で指定されたRangeオブジェクトをSelectする'
  Call tgtRange.Select
  '一旦右にカーソルを移して親文字のフォントサイズを取得'
  Call Selection.MoveRight(wdCharacter, 1, wdMove)
  Dim parentFontSize As Single
  parentFontSize = Selection.Font.Size
  '親文字のフォントサイズと、引数tgtOffsetを元に、Raise値を取得'
  Dim tgtRaise As Long
  tgtRaise = Int(parentFontSize) - 1 + tgtOffset
  '再度親文字を選択状態にし、PhoneticGuideメソッドを実行'
  Call tgtRange.Select
  Call Selection.Range.PhoneticGuide( _
                         Text:=tgtRubyText, _
                         Alignment:=tgtAlignment, _
                         Raise:=tgtRaise, _
                         fontSize:=tgtRubySize, _
                         FontName:=tgtFontName)
  'ルビを施した文字列を選択状態にする'
  Call Selection.MoveRight(wdCharacter, 1, wdSelection)
End Sub

ちょっと引数祭り状態だが、そもそも[Range].PhoneticGuideメソッドが引数祭りメソッドなので許してほしい。

何といっても、ルビの親文字からの距離を指定できるようにしたことがポイント。

実は、めっちゃめんどくさいことをしている。

  '引数で指定されたRangeオブジェクトをSelectする'
  Call tgtRange.Select
  '一旦右にカーソルを移して親文字のフォントサイズを取得'
  Call Selection.MoveRight(wdCharacter, 1, wdMove)
  Dim parentFontSize As Single
  parentFontSize = Selection.Font.Size
  '親文字のフォントサイズと、引数tgtOffsetを元に、Raise値を取得'
  Dim tgtRaise As Long
  tgtRaise = Int(parentFontSize) - 1 + tgtOffset

コメントを読んでもらったら、いかにめんどくさいことをしているのか、わかっていただけると思う。

使ってみる

たとえば、

この状態で、

このように「本気」の部分を選択し、次のコードを実行。

リスト２

Private Sub testPhoneticGuide()
  Call callPhoneticGuide(tgtRange:=Selection.Range, _
                         tgtRubyText:="マジ", _
                         tgtOffset:=1, _
                         tgtRubySize:=5)
End Sub

すると、

こうなる。

ルビの設定を確認すると、

バッチリ。

さらに、同じ箇所を選択した状態で次のコードを実行。

リスト３

Private Sub testPhoneticGuide()
  Call callPhoneticGuide(tgtRange:=Selection.Range, _
                         tgtText:="マジ", _
                         tgtOffset:=0, _
                         tgtRubySize:=5, _
                         tgtFontName:=MS_P_GOTHIC)
End Sub

今度は、オフセット値を0にし、ルビのフォントを「ＭＳ Ｐゴシック」にしてみる。

すると、

こうなる。

ルビの設定を確認すると、

やはりバッチリ。

おわりに

これで使いやすくなった。

基本、これでルビを設定し、細かなチューニングはフィールドコードをFindオブジェクトを用いて書き換えるようにすれば良い。

安心の実行結果(Word)

安心の実行結果

先日、

akashi-keirin.hatenablog.com

このような、衝撃的な実行結果についてお伝えした。

今回は、安心の実行結果である。

フォントサイズは0.5の倍数のみ？

今まであまり気にしたことはなかったのだが、ルビのフィールドコードをいじくっていてちょっと気になったことがあった。

なぜ、ルビのフォントサイズをフォントサイズの2倍の値で取り扱うのか

ということ。

「フォントサイズが6.2とかだったらどうすんだ？　整数にならんぞ？」と思ったのだ。

で、ちょっとやってみた。

フォントサイズ表示・設定窓に「10.6」を入れてみる

初期状態はこれ。選択箇所のフォントサイズは、見てのとおり「12」だ。

ここに、「10.6」というちゅ～とはんぱな数値を入力してみる。

んで、確定してみると……、

ち～んｗｗｗ

あえなく撃沈ｗ

VBAで設定するとどうなるか

手動でだめなら、VBAで指定するとどうなるのだろうか。

イミディエイト・ウィンドウに

Selection.Font.Size = 10.6

と入力して、[Enter]を押してみる。

フォント名に「ち～んｗ」を指定することはできたが、如何。

おお！　「10.5」に修正されておる！

おわりに

これは安心！

ルビが施された部分のフォント情報を取得する(Word)

ルビが設定された部分のフォント情報を取得する

選択箇所のフォント情報を取得するときには、Selection.Fontオブジェクトにアクセスすればよい。たとえば、

Selection.Font.Name

とすれば、カーソル位置のフォント名が取得できる。

……はずだ。

ルビが設定されている場合の挙動

次の画像をご覧いただきたい。

「強敵」の直前にカーソルがある。「強敵」の部分は「ＭＳ ゴシック」。その他の部分は「ＭＳ 明朝」である。

このとき、フォント名表示窓の表示は、「ＭＳ 明朝」。

直前の部分のフォント名を表示しているようだ。

次。[Shift]＋[→]で、「強敵」を選択状態にしてみる。

！

フォント名表示窓が空白に!!!!

この状態で、イミディエイト・ウインドウに

?Selection.Characters(1).Text

?Selection.Font.Name

?Selection.Font.Size

の三つを入力して実行してみると、それぞれ

もう、まったくわけのわからない結果が返る。

次に、[→]ボタンを押して、カーソルを「強敵」の直後に持って行く。

フォント名表示窓の表示は、

これは、やはり直前の部分のフォント名を表示しているらしい。

ルビが設定されている箇所のフォント情報を取得する

上記の挙動から、ルビの部分が選択されている状態で選択部分のフォント情報を得るには、

• 一旦カーソルを右に移動する
• フォント情報を取得する
• 選択状態に戻す

という操作が必要であると考えた。

ルビが施された親文字のフォント情報を取得する

リスト１

Private Sub getRubiedCharFontInfo()
  Dim currRange As Range  '……(1)'
  Set currRange = Selection.Range
  Call Selection.MoveRight(wdCharacter, 1, wdMove)  '……(2)'
  Debug.Print "フォント名：" & Selection.Font.Name  '……(3)'
  Debug.Print "フォントサイズ：" & Selection.Font.Size
  Call currRange.Select  '……(4)'
End Sub

まず(1)の

Dim currRange As Range
Set currRange = Selection.Range

で、選択範囲をRange型の変数に突っ込んでおく。

んで、(2)の

Call Selection.MoveRight(wdCharacter, 1, wdMove)

でカーソルを1文字分だけ右に移動。これで、ルビを施した文字列の直後にカーソルが来る。

すかさず(3)の

Debug.Print "フォント名：" & Selection.Font.Name
Debug.Print "フォントサイズ：" & Selection.Font.Size

でフォント情報を取得してイミディエイトに表示。

最後に(4)の

Call currRange.Select

で、(1)で保存しておいたRangeオブジェクトを選択する。

実行結果

イミディエイトの出力はバッチリ。

ドキュメント（笑）の方も、見かけ上は元どおり。

うむ！

おわりに

ただ、同じ選択範囲に異なるフォントがチャンポンになっていたら詰む……？

衝撃の実行結果(Word)

衝撃の実行結果

最近、WordのVBAでのルビ操作にハマっている。

[Range].PhoneticGuideメソッドでルビを振るのだが、あまり細かい調整ができず、さりとてルビを振った後Field.Code.Textプロパティの値をVBAで書き換えると、

ドキュメントを開きなおしたときにフォント名情報が死ぬ

という結構悲惨なことが起こる。【参考】

仕方なく、上記リンクでも紹介したように、

一旦[Range].PhoneticGuideメソッドでルビを振った後、フィールドコードを表示させて置換する

というしちめんどくさいことをすることになった。

その中で、一つ素朴な疑問が湧いたのである。

素朴な疑問

ルビのフォントの種類を変えるメソッドを作ろうとしたとき、ふと

これ、存在しないフォント名を指定したらどないなるんやろ？

と思ったのだ。

で、やってみた。

このように、ドキュメント（笑）の「わ」の部分（ＭＳ 明朝）を選択した状態で、次のコードを実行するのである。

リスト１

Private Sub testInvalidFontName()
  Selection.Font.Name = "ち～んｗ"
End Sub

見ての通り、選択部分のフォント名に「ち～んｗ」というふざけた名前を指定してみるのである。

結果、どうなるか。

なんと、こうなるのである。

エラーが出るわけではないのである。

おわりに

これは困ったことではなかろうか。

おかしなフォント名が引数で指定されても防ぎようがないではないか。

……というわけで、当面、〈ルビのフォント名を指定するメソッド〉については、使用できるフォントを制限する方向で実装することにします。

しっかし、「フォント名：ち～んｗ」ってなんやねんな。

マクロでルビ振りをするときの注意(Word)

マクロでルビ振りをするときの注意(Word)

Word VBA のバグを発見したので、ここで盛大に晒しますｗ

[Range].PhoneticGuideメソッドでルビを振る

まず、次のようなドキュメント（笑）を用意する。

選択部分を見たらわかるように、フォントは「ＭＳ 明朝」。

んで、こいつに、次のリスト１を実行する。

リスト１

Private Sub TestPhoneticGuide()
  Const MS_P_MINGZHAO As String = "ＭＳ Ｐ明朝"
  Call Selection.Range.PhoneticGuide( _
                         Text:="とも", _
                         Alignment:=wdPhoneticGuideAlignmentOneTwoOne, _
                         Raise:=10, _
                         FontSize:=5, _
                         FontName:=MS_P_MINGZHAO)
End Sub

[Range].PhoneticGuideメソッドを用いて、「強敵」という親文字に、5ポイントのＭＳ Ｐ明朝で「とも」とルビを振るコード。

こうなる。

で、「強敵」の部分を調べると、

このように、ちゃんと5ポイントのＭＳ Ｐ明朝で「とも」とルビが振られていることがわかる。

ここで、一旦ドキュメント（笑）を閉じ、開き直す。

もう一度、「強敵」の部分を調べる。

何も変わっていない。当り前だけど。

ここで、フィールドコードを調べる。

EQ \* jc2 \* "Font:ＭＳ Ｐ明朝" \* hps10 \o\ad(\s\up 10(とも),強敵)

こうなっている。

「hps10」の部分がルビのフォントサイズを表す。実際のサイズ（5ポイント）の2倍の数値が記録されている。

マクロでルビのフォントサイズを変更する

このフィールドコードをマクロで書き換えてみる。

リスト２

Private Sub testReplaceFieldCode()
  Dim tgtField As Field
  With Selection.Fields(1)
    .Code.Text = Replace(.Code.Text, "hps10", "hps9")
  End With
End Sub

選択範囲のField.Codeプロパティの返り値（Rangeオブジェクト）のTextプロパティがフィールドコード文字列を表すので、その「hps10」を「hps9」に置換してやれば、フォントサイズは4.5ポイントに変わる。

リスト２を実行した後、「強敵」の部分を調べると、

ちゃんとフォントサイズが4.5ポイントになっている。

フィールドコードはこのとおり。ちゃんと「hps9」になっているのがわかる。

ドキュメント（笑）を開き直す

さて、先ほどのドキュメント（笑）を一旦閉じて開き直すと、どうなるか。

おわかりだろうか。

なんと、ルビのフォントが親文字と同じ「ＭＳ 明朝」に化けてしまうのである。

これは、結構深刻な問題ではなかろうか。

回避策

ちなみに、フォントサイズだけではなく、フォントの種類など、とにかくマクロでフィールドコードを書き換えると、同様のことが起こる。

今回は、親文字がＭＳ 明朝、ルビがＭＳ Ｐ明朝という非常に違いのわかりづらい（笑）例だったが、ゴシック系の親文字に明朝系のルビ、みたいなときは非常に困る。

今のところ回避策としては、

• [Range].PhoneticGuideでルビを振る
• [Alt]+[F9]でフィールドコードを表示する
• [Ctrl]+[H]で置換ダイアログを表示する
• 関係するフィールドコード文字列を置換する

ぐらいしか思いつかない。

今回の例だと、

[Alt]+[F9]でフィールドコードを表示し、

[Ctrl]+[H]で置換ダイアログの「検索する文字列」に「hps10」、「置換する文字列」に「hps9」を入力して[置換]ボタンをクリック。

完了。

「強敵」のところを調べると、

このとおり。

今度は、一旦閉じて開き直しても、

大丈夫。

おわりに

わけのわからんことが起こるなあ。

Selection.MoveRightメソッド(Word)の挙動に注意

［Selection］.MoveRightメソッドの挙動に注意

[Selection].MoveRightメソッド（[Selection].MoveLeftメソッド）を使用していて軽くハマったので、記しておく。

[Selection].MoveRightメソッド

[Selection].MoveRightメソッドというのは、Wordでドキュメント上のカーソルを動かすメソッド。

akashi-keirin.hatenablog.com

このときにも触れたことがある。

文字通りカーソルを右に動かすメソッド。

簡単におさらいをしておくと、使うときは

Call [Selection].MoveRight([Unit], [Count], [Extend])

と書く。

で、

• 引数Unitで移動の単位
• 引数Countで移動の量
• 引数Extendで移動の仕方（単純にカーソルを動かすか、ドラッグしたように動かすか）

をそれぞれ指定する。

たとえば、

Selection.MoveRight(wdCharacter, 1, wdExtend)

と書けば、

• 文字単位で
• 1だけ
• ドラッグしたように

カーソルを右に動かすことになる。

通常の挙動

たとえば、

このようなドキュメント（笑）上で、「強敵」の直前にカーソルを置いて、次のリスト１を実行するとどうなるか。

リスト１

Private Sub moveCursorTest()
  Call Selection.MoveRight(wdCharacter, 1, wdExtend)
End Sub

当然、

こうなる。

何の不思議もない。疑問などあろうはずがありません。

文字にルビが振られているとき

では、文字にルビが振られているとどうなるか。

今度は、先ほどのドキュメント（笑）を、

このように変更する。「強敵」の２文字に「とも」とルビを振った。

この状態で、「強敵」の直前にカーソルを置いて、リストを実行してみる。

すると、

なんと、こうなるのである！

おわりに

キーボード操作と全く同じ結果になるとはいえ、少し注意が必要かも知れない。

ハイライト部分を切り替えるマクロ(Word)

ハイライト部分を切り替えるマクロ

コードだけ掲載しておく。

クラスモジュールと標準モジュールを使った。

ハイライト部分を保持するクラス

ハイライト部分を保持し、ハイライト部分の再取得、ハイライトのオンオフ切り替えができるようなオブジェクト。

クラスモジュール HighLightedRanges

Option Explicit

Private parent_ As Document
Private ranges_ As Collection

Public Property Get Parent() As Document
  Set Parent = parent_
End Property

Public Property Get Ranges() As Collection
  Set Ranges = ranges_
End Property

Public Property Get Count() As Long
  Count = ranges_.Count
End Property

Public Property Get Item(ByVal Index As Variant) As Range
  Set Item = ranges_(Index)
End Property

Private Sub Class_Initialize()
  Set parent_ = ThisDocument
  Set ranges_ = New Collection
End Sub

Public Sub getHighLightedRanges()
  On Error GoTo Finalizer
  Application.ScreenUpdating = False
  Dim currentRange As Range
  Set currentRange = Selection.Range
  Call parent_.Range(0, 0).Select
  'ドキュメント内のハイライト部分を取得'
  Dim tmp As Range
  Do
    Set tmp = getNextHighLight(Selection.Range)
    If tmp Is Nothing Then Exit Do
    If Not isValid(tmp) Then Exit Do
    Call ranges_.Add(tmp)
    DoEvents
  Loop
  'テキストボックス内のハイライト部分を取得'
  Set tmp = Nothing
  Dim shp As Word.Shape
  For Each shp In parent_.Shapes
    If shp.Type = msoTextBox Then
      Call shp.TextFrame.TextRange.Select
      Call Selection.Collapse(wdCollapseStart)
      Do
        Set tmp = getNextHighLight(Selection.Range)
        If tmp Is Nothing Then Exit Do
        If Not isValid(tmp) Then Exit Do
        Call ranges_.Add(tmp)
        DoEvents
      Loop
    End If
  Next
  Call currentRange.Select
Finalizer:
  Application.ScreenUpdating = True
End Sub

Private Function isValid( _
    ByVal targetRange As Range) As Boolean
  isValid = False
  With targetRange
    Select Case .Text
      Case "": Exit Function
      Case vbCrLf: Exit Function
      Case vbCr: Exit Function
      Case vbLf: Exit Function
      Case vbNewLine: Exit Function
    End Select
  End With
  isValid = True
End Function

Private Function getNextHighLight( _
             ByVal currentRange As Range) As Range
  Set getNextHighLight = Nothing
  Dim ret As Range
  Set ret = Nothing
  '渡されたRangeオブジェクトにカーソルを置く'
  Call currentRange.Select
  '念のため選択箇所を潰しておく'
  Call Selection.Collapse(wdCollapseStart)
  With Selection.Find
    Call .ClearFormatting
    Call .Replacement.ClearFormatting
  End With
  'Findオブジェクトの諸設定'
  With Selection.Find
    .Text = ""
    .Replacement.Text = ""
    'これをwdFindStopにしておかないと、検索が終わらない'
    '文書の最後にカーソルがあるときに、先頭から検索してしまう'
    .Wrap = wdFindStop
    .Format = False
    .Highlight = True
    .MatchCase = False
    .MatchWholeWord = False
    .MatchByte = False
    .MatchAllWordForms = False
    .MatchSoundsLike = False
    .MatchWildcards = False
    .MatchFuzzy = False
  End With
  '検索実行'
  Call Selection.Find.Execute
  'ヒットしなければNothingを返す'
  If Not Selection.Find.Found Then Exit Function
  '返り値用変数に検索ヒットしたRangeオブジェクトをセット'
  Set ret = Selection.Range
  '次の検索用に選択範囲を後方に潰す'
  Call Selection.Collapse(Direction:=wdCollapseEnd)
  '返り値をセット'
  Set getNextHighLight = ret
  DoEvents
End Function

Public Sub toggleHighLight()
  If Me.Count = 0 Then Exit Sub
  Dim i As Long
  For i = 1 To Me.Count
    With ranges_(i)
      If .HighlightColorIndex = wdYellow Then
          .HighlightColorIndex = wdNoHighlight
      Else
        .HighlightColorIndex = wdYellow
      End If
    End With
  Next
End Sub

プロパティたくさんと、メソッド二つ。

メソッド呼び出し用コード

標準モジュールに呼び出し用コードを書く。

リスト１

Option Explicit

Private hlRanges As HighLightedRanges

'HighLightedRangesクラスのインポート必須'
Public Sub createInstance()
  Set hlRanges = New HighLightedRanges
  Call hlRanges.getHighLightedRanges
End Sub

Private Sub getHighligetedRangeCaller()
  Dim res As VbMsgBoxResult
  res = MsgBox(Prompt:="ハイライト部分を取得し直します。" & vbCrLf & _
                       "よろしゅうござるか？", _
               Buttons:=vbYesNoCancel, _
               Title:="し、正気でござるか？(´・ω・`)")
  If res <> vbYes Then
    Call MsgBox(Prompt:="やめたでござる。", _
                Title:="なんやねん、それ ( `д´)、ﾍﾟｯ")
    Exit Sub
  End If
  Call createInstance
End Sub

Private Sub toggleHighlightCaller()
  If hlRanges Is Nothing Then Call createInstance
  Call hlRanges.toggleHighLight
End Sub

クイック アクセス ツール バーに登録して呼び出すことを想定しているので、getHighligetedRangeCallerメソッドはPrivate指定。ただし、createInstanceメソッドは、ThisDocumentのOpenイベントで実行したいのでPublic指定。

動作

getHighligetedRangeCallerメソッドで、ハイライト部分を取得。

んで、toggleHighlightCallerメソッドでハイライトのオンオフ切り替え。

こいつらをクイック アクセス ツール バーに登録しといて呼び出すと、前にお目にかけたように

こんなふうに動く。

おわりに

今のところ、大量にあるプロパティのほとんどが役に立っていませんが、それは今後の検討課題ということで……。