Word VBA ルビの情報を ActiveDocument.Fields(n).Code から探ってみた #Word #VBA #デバッグ

人力検索から浮気して teratail の質問に回答してみた。
テスト不足で、浮気先で恥をかいてしまったぉぃぉぃ
※正確には、人力検索でもダメ回答で恥をかいていたりするんだけど・・・

浮気先(質問元)
teratail.com
https://teratail.com/questions/j9rj56gr6h3a0m
他の回答やコメントも参考にしてください。

なんて、挨拶は、置いといて、
Word VBA のルビ処理について遊んでみました(遊ばれてます)

いつものあのあのそのその酔っ払い解説動画・・・
https://www.youtube.com/watch?v=QcljoRs1Rsc
↑※良くイライラすると上級者に言われます・・・・

00:00 バグ・不具合内容の説明
02:04 ActiveDocument.Fields(n).Code でルビの情報が取れます
03:40 ActiveDocument.Fields(n).Select '単純にSelectで選択状態にする
04:50 バグの原因を繰り返し説明段落から ActiveDocument.Paragraphs(n).Range.Text
05:40 結合テスト ↑上記単体テストをふまえて結合テスト

ルビがふられていると、
段落から ActiveDocument.Paragraphs(n).Range.Text で取得すると
ルビがふられた文字列が取得できなかった・・・・

google:VBA Word ルビ取得などで検索すると、ActiveDocument.Fields の中に情報がありそうでした。

strルビ情報 = ActiveDocument.Fields(n).Code 'フォントやフリガナ情報含む
ActiveDocument.Fields(n).Select '単純にSelectで選択状態にする

みたいにして、ルビの文字列取得と選択することができました。

Option Explicit

'ルビ付きの文字は、Fieldで管理されている
Sub test20220124ルビのテスト()

    Dim n As Integer
    
    For n = 1 To ActiveDocument.Fields.Count
        Debug.Print "Fileds(" & n & "):" & ActiveDocument.Fields(n).Code
    Next n

End Sub

'なので、位置を知りたかったら、ActiveDocument.Fields(n)をSelectして
'Selection.Range.Information 選択位置の情報を取得する
Sub test20220124ルビと位置をMsgboxで表示テスト()
    
    Dim n As Integer
    Dim strルビ情報 As String   'ActiveDocument.Fields(n) なので、ルビ以外もあるけどね
      
    Dim p As Integer
    Dim l As Integer
     
    For n = 1 To ActiveDocument.Fields.Count
        Debug.Print "Fileds(" & n & "):" & ActiveDocument.Fields(n).Code
        
        strルビ情報 = ActiveDocument.Fields(n).Code 'フォントやフリガナ情報含む
        
        ActiveDocument.Fields(n).Select  '単純にSelectで選択状態にする
        
        p = Selection.Range.Information(wdActiveEndPageNumber) 'ページ
        l = Selection.Range.Information(wdFirstCharacterLineNumber) '行
        MsgBox strルビ情報 & vbCrLf & "現在選択されている位置: " & p & "P、" & l & "行目です"
    Next n

End Sub


'ソースコードや他の回答は
' https://teratail.com/questions/j9rj56gr6h3a0m
'を見てください。※かっこつけるのに失敗したなぁ・・・ぉぃぉぃ
'下記、Excel側のコードです。参考となれば幸いです。

'上記、単体テストのコードをExcel側に組み込んでみます
'ルビを振った文字列を検索する※ルビが別に管理されていることに気が付く・・・
Sub test20220124WORD検索テスト3ルビを探る()

    Dim wdApp As Word.Application
    Set wdApp = GetObject(, "Word.Application")

    If wdApp Is Nothing Then
        MsgBox "テスト用のWORD文章を開いてから、再テストしてね"
        Exit Sub
    End If

    Dim i As Integer
    Dim iRow As Integer
    
    Dim maxRow As Integer
    Dim wd As String
    Dim p As Integer, l As Integer   'ページ、行
    
    Dim n As Integer '段落のカウンターで使用
    Dim str段落文字列 As String
    Dim n先頭位置 As Integer
    
    Dim strルビ情報 As String   'ActiveDocument.Fields(n) なので、ルビ以外もあるけどね 2022/01/24追加
    
    maxRow = 3 '最終行を代入してね テストで3個固定なので、修正してね
    iRow = 1   '結果一行目から、あっ、実行時に結果のシート消さなきゃ↓・・・
    ThisWorkbook.Worksheets("結果").Range("A:B").Clear  'A,B列をクリア

    For i = 1 To maxRow
        wd = ThisWorkbook.Worksheets("検索文字列").Range("A" & i + 1).Value  '検索文字列
        
        'アクティブ文書の段落を頭からなめる ActiveDocument.Paragraphs
        For n = 1 To wdApp.ActiveDocument.Paragraphs.Count
            str段落文字列 = wdApp.ActiveDocument.Paragraphs(n).Range.Text
            '単純にInstrで探してみた
            n先頭位置 = InStr(1, str段落文字列, wd) '初回は一文字目から探す
            While n先頭位置 <> 0 '検索位置が見つかっている間 0以外の時ループ
                If n先頭位置 > 0 Then '↑で文字が見つかったら、
                    wdApp.ActiveDocument.Paragraphs(n).Range.Select   '見つけたので段落選択する
                    '↑段落全体が選択されているので、↓選択範囲、start位置を移動
                    wdApp.Selection.MoveStart Unit:=wdCharacter, Count:=n先頭位置 - 1
                    '結果をExcelへ書く、
                    p = wdApp.Selection.Range.Information(wdActiveEndPageNumber)
                    l = wdApp.Selection.Range.Information(wdFirstCharacterLineNumber)
                    With ThisWorkbook.Worksheets("結果")
                        .Range("A" & iRow) = p & "P、" & l & "行目"
                        .Range("B" & iRow) = wd
                    End With
                    iRow = iRow + 1
                End If
                            
                '次の位置(見つけた位置+検索文字数)から検索文字を探す
                n先頭位置 = InStr(n先頭位置 + Len(wd), str段落文字列, wd) '同じ段落に検索文字があるかもしれないので
            
            Wend
            
        Next n
        
        'ルビを探る、探す 2022/01/24 追加
        For n = 1 To wdApp.ActiveDocument.Fields.Count
            strルビ情報 = wdApp.ActiveDocument.Fields(n).Code 'フォントやフリガナ情報含む
            If InStr(strルビ情報, wd) > 0 Then 'Filed ルビの情報 から 検索ワードが見つかったら
                wdApp.ActiveDocument.Fields(n).Select  '単純にSelectで選択状態にする
                '結果をExcelへ書く、
                p = wdApp.Selection.Range.Information(wdActiveEndPageNumber)
                l = wdApp.Selection.Range.Information(wdFirstCharacterLineNumber)
                With ThisWorkbook.Worksheets("結果")
                    .Range("A" & iRow) = p & "P、" & l & "行目"
                    .Range("B" & iRow) = wd
                End With
                iRow = iRow + 1
            End If
        Next n


    Next



    MsgBox "処理終了、結果を確認してください"

End Sub

テスト不足を痛感しつつ、
Word VBA でルビを探す時の参考となれば幸いです。

いつものあのあのそのその酔っ払い解説動画・・・
www.youtube.com
https://www.youtube.com/watch?v=QcljoRs1Rsc
↑※良くイライラすると上級者に言われます・・・・
00:00 バグ・不具合内容の説明
02:04 ActiveDocument.Fields(n).Code でルビの情報が取れます
03:40 ActiveDocument.Fields(n).Select '単純にSelectで選択状態にする
04:50 バグの原因を繰り返し説明段落から ActiveDocument.Paragraphs(n).Range.Text
05:40 結合テスト ↑上記単体テストをふまえて結合テスト