Office関連

ルビ(ふりがな)を一括設定するWordマクロ(改良版)

これまで当ブログではルビを設定するWordマクロについて、いくつか記事を書いてきました。

それらはExcelを利用するものであったり、ルビダイアログを無理やり操作するものであったりして、あまり実用的ではないレベルのマクロでした。

そして今日たまたま気が付いたのがDialogオブジェクトのShowメソッドの引数。

Timeout(省略可能):ダイアログ ボックスを自動的に閉じるまでの時間を指定します。基本となる単位は約 0.001 秒です。システム アクティビティを同時に実行すると、有効時間の値が増えます。この引数を省略した場合、ユーザーがダイアログ ボックスを閉じたときにダイアログ ボックスは閉じます。

こんなのあったのか!
Wordマクロを触って何年か経ちますが、まったく気が付きませんでした。
これ使えばこの記事でやっているような、モーダルダイアログの操作とか要らないじゃん!!
・・・まったく、自分の無知さに呆れ果てます。

とはいえ、これで上記記事のコードも大分改善されるので、マクロを書き直すことにしました。

Option Explicit
 
Public Sub Sample01()
'選択した範囲内の文字列にルビ設定
  SetPhoneticRange Selection.Range
End Sub

Public Sub Sample02()
'文書全体にルビ設定
  SetPhoneticRange ActiveDocument.Range
End Sub

Private Sub SetPhoneticRange(ByVal rng As Word.Range)
'指定した範囲のルビ一括設定
  Dim r As Word.Range
 
  '単語単位で処理
  For Each r In rng.Words
    'ルビが振られていないか最初にフィールド数で判定
    If r.Fields.Count < 1 Then
      If ChkKanjiRange(r) = True Then
        r.Select
        Application.Dialogs(wdDialogPhoneticGuide).Show 1
      End If
    End If
  Next
 
  '文字単位で処理
  For Each r In rng.Characters
    'ルビが振られていないか最初にフィールド数で判定
    If r.Fields.Count < 1 Then
      If ChkKanjiRange(r) = True Then
        r.Select
        Application.Dialogs(wdDialogPhoneticGuide).Show 1
      End If
    End If
  Next
End Sub
 
Private Function ChkKanjiRange(ByVal rng As Word.Range) As Boolean
'指定したRangeが漢字のみかチェック
  Dim ret As Boolean
  Dim i As Long
  
  ret = True
  For i = 1 To Len(rng.Text)
    If IsKanji(Mid(rng.Text, i, 1)) = False Then
      ret = False
      Exit For
    End If
  Next
  ChkKanjiRange = ret
End Function
 
Private Function IsKanji(ByVal char As String) As Boolean
'漢字判別
'※ 参考Webページ
' - http://www.taishukan.co.jp/kokugo/webkoku/series003_04.html
' - http://en.wikipedia.org/wiki/CJK_Unified_Ideographs_%28Unicode_block%29
' - http://www.asahi-net.or.jp/~ax2s-kmtn/ref/unicode/e_asia.html
' - http://www.gsid.nagoya-u.ac.jp/ohna/notes/nu/regex4kanji2.txt
' - http://support.microsoft.com/kb/161304/ja
  Dim cc As Variant
  Dim ret As Boolean
  
  ret = True '初期化
  cc = Val("&H" & Hex(AscW(char)) & "&")
  Select Case cc
    Case 63744 To 64255   'CJK互換漢字(U+F900-U+FAFF)
    Case 13312 To 19903   'CJK統合漢字拡張A(U+3400-U+4DBF)
    Case 19968 To 40959   'CJK統合漢字(U+4E00-U+9FFF)
    Case 131072 To 173791 'CJK統合漢字拡張B(U+20000-U+2A6DF)
    Case 173824 To 177983 'CJK統合漢字拡張C(U+2A700-U+2B73F)
    Case 177984 To 178207 'CJK統合漢字拡張D(U+2B740-U+2B81F)
    Case 194560 To 195103 'CJK互換漢字補助(U+2F800-U+2FA1F)
    Case Else
      ret = False
  End Select
  IsKanji = ret
End Function

word_vba_setphoneticrange_01

やっていることはこれまでの記事と大して変わりはありません。
文字コードで漢字かどうかを判別して、漢字の場合のみルビダイアログを使って、ルビ設定を行っています。

ただ、Word 2010で試したところ、いくつかの文字列でルビ設定に失敗してしまうようでした。
失敗してしまう原因については掴みきれていませんが、そのうち修正できたら修正します。

関連記事

  1. Office関連

    Excelで地理データや株価情報を取得する方法

    下記記事にある、今年3月に追加された「データの種類」機能を使って、Ex…

  2. Office アドイン

    [Office用アプリ]Random Data Generator

    Random Data Generatorはテスト用の個人情報データを…

  3. アイコン一覧

    Office 2013 アイコン一覧(V)

    ・Office 2013 アイコン一覧 NUM…

  4. Office関連

    SkyDriveの同期フォルダーのパスを取得するWordマクロ

    無料で使える便利なクラウドストレージ「SkyDrive」にはローカルフ…

  5. Office関連

    Faviconをダウンロードするマクロ

    WebサイトからFaviconを抜き出すAPIがあったので早速使ってみ…

コメント

  • コメント (2)

  • トラックバックは利用できません。

    • kim135797531
    • 2017年 7月 15日

    こんにちは。

    日本語の勉強のためWordにルビを一括設定させる機能を探す途中、このブログを見つけました。良いマクロを公有してくれて、ありがとうございます!(なんでWordでこんな基本的な機能がないのかは不思議ですが。。)

    ルビ設定に失敗する時の原因について私が一つ見つけたものは、Wordプログラム画面の一番下にある「言語」設定で、日本語ではなく他の言語(英語、韓国語など)が設定されている時、変換に失敗することです。

    そして人々、我々などの「々」という文字がある時も変換に失敗しています。

    上の問題ぐらいを自分で設定すると、あとは自動完成に成功しました^o^

    • なきお
    • 2018年 5月 10日

    ルビ振りを一括で出来るフリーソフトがないか探していましたら
    ここにたどり着きました。
    早速使ってみましたがたいへん便利で気に入ってます。
    ありがとうございます!

Time limit is exhausted. Please reload CAPTCHA.

最近の記事

アーカイブ

RapidSSL_SEAL-90x50
PAGE TOP