青空文庫のルビ【素人 Word マクロ】

Microsoft officeのWordVBAでマクロを組みましたので公開します。

インターネットで検索したり、マクロの記録機能を使ったりしたのを組み合わせだけなので、上手くはないですが、一応動くはずです。

office2021です。

必ず、元データのバックアップを取ってから実行してください。

素人の作ったものなので、信用しすぎないでください。

[内容]

青空文庫でテキストをダウンロードすると、ルビが、《》によって振られていることがあります。
Wordに貼り付けた後、《》内の文字を一つ前の単語にルビとして設定するマクロです。

※以下の方法のほうが上手くいくようです(2023/09/03編集)

---

[注意点]

注意点は、「Wordが認識している1単語」をもとにしているので、接辞や複合語になると不具合が出ることです。

---

[画像]

変換前１

変換後１

変換前２

変換後２

---

[コード]

Sub 青空文庫ルビ()
    Dim doc As Document
    Set doc = ActiveDocument
    Dim startTagPos As Long
    Dim endTagPos As Long
    Dim rubyText As String
  
  
       ' ドキュメントの内容を全て選択
         doc.Content.Select
         
    Do While InStr(1, Selection.Text, "《") > 0 And InStr(1, Selection.Text, "》") > 0
    
        ' 最初の《と》の位置を取得

        startTagPos = InStr(1, Selection.Text, "《")
        endTagPos = InStr(1, Selection.Text, "》")
        
        ' ルビとなる文字を取得

        rubyText = Mid(Selection.Text, startTagPos + 1, endTagPos - startTagPos - 1)
        
        ' ルビを適用

   ActiveDocument.Bookmarks("\StartOfDoc").Select

    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "《"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With

    Selection.Find.Execute
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
    Selection.Range.PhoneticGuide Text:=rubyText, Alignment:=wdPhoneticGuideAlignmentOneTwoOne, Raise:=10, FontSize:=5
    
    ActiveDocument.Bookmarks("\StartOfDoc").Select

    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "《*》"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchByte = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchFuzzy = False
        .MatchWildcards = True
    End With
    Selection.Find.Execute
    Selection.TypeBackspace
    
        
    ' ドキュメントの内容を全て選択
    doc.Content.Select
    
 Loop
 
End Sub

[マクロについて]

ファイルタブ→その他→オプション→ユーザーのリボン設定→開発タブを追加、でマクロが導入できます。検索してください。

---

素人の作ったものなので、信用しすぎないでください。